Let's大谷家 あんたの日記

Just another WordPress site

【VBA→WSF】Excelでセルのコメントを設定する方法

      2014/10/18

先日、【VBA】Excelで必要なセルを選択する方法って記事を書きましたが、その続き。

Excelマクロで作ると、Excelを開かなきゃならない。
それじゃめんどくさいということで、VBScript(WSH)にすっかと書き始めた。
んだけど、バッチ的な簡易にダラダラと記述しなければならない。
できれば、プロシージャとか、外部ファイル読込もしたい。

調べた結果、WSFって形式があるとのこと。
その形式でやれば、考えていたこと、殆ど出来るみたい。
と、いうことで、ファイルも選択させて汎用的に作り直してみた。

<JOB>
<COMMENT>
************************************************************
※ Excelコメント付与スクリプト
************************************************************
【処理概要】
 Excelブックに「本体」「コメント情報」の2つのシートを作成
 「コメント情報」のセルにコメント情報を設定
 「本体」に「コメント情報」のセルに情報が入ってるセル内情報を
 「本体」の同一セルのコメント情報として設定
************************************************************
以下、オブジェクト宣言内容
・WScript.Shell
 基本的なものが詰まったオブジェクト。とりあえず入れとく
・Excel.Application
 Excelマクロ関連オブジェクト。Excel操作するなら入れとく
・Scripting.FileSystemObject
 ファイル操作関連のオブジェクト。ファイル操作必要な場合は入れとく
************************************************************
</COMMENT>
<OBJECT id="WshShell" progid="WScript.Shell" />
<OBJECT id="ExcelApp" progid="Excel.Application" />
<OBJECT id="FS" progid="Scripting.FileSystemObject" />

<!-- 外部VBSファイルの参照 -->
<!-- 普通のJavaScriptみたいに以下のとおり記述すればOK -->
<SCRIPT language="VBScript" src="./common.vbs"></script>

<!-- ここから本処理 -->
<SCRIPT language=VBScript>
' ***********************************************************
' 処理開始
' ***********************************************************

'定数宣言
'ExcelSheet名
 Const sheetName = "本体"
 Const sheetNameComment = "コメント情報"
'特定セル参照メソッド定数
 Const xlCellTypeComments = -4144
 Const xlCellTypeConstants = 2

'変数宣言
'ファイル情報関連
 Dim fullFName
 Dim fName
'コメント
 Dim comment

 With ExcelApp

'処理ファイル選択
 fullFName = .GetOpenFilename("*.xls")
'フルパスからファイル名のみ抽出
 fName = FS.getFileName(fullFName)

'処理開始案内
'選択したファイルを確認させるためにメッセージボックス表示
 inFileMsg()

' 指定Excelファイルを表示
' 各種オブジェクト設定(ブック内シートのオブジェクト)
 Set objBook = .Workbooks.Open(fullFName)
 Set objSheet = .Worksheets(sheetName)
 Set objSheetComm = .Worksheets(sheetNameComment)

'コメント反映先の既存コメントクリア
'マクロ2度目実行の時のエラー防止
 objBook.Activate
 objSheet.Select
' コメント1個も入ってないとエラーになるのでエスケープ
 On Error Resume Next
 .Selection.SpecialCells(xlCellTypeComments).Select
 On Error GoTo 0
' コメント設定されてるセルのコメント解除
 For Each cel In .Selection
    objSheet.Range(cel.Address).Select
    .Selection.ClearComments
 Next

' コメント情報が設定されたシートの文字列入力セルの取得
 objSheetComm.Select
' コメント1個も入ってないとエラーになるのでエスケープ
 On Error Resume Next
 .Selection.SpecialCells(xlCellTypeConstants).Select
 On Error GoTo 0

' コメント設定
 For Each cel In .Selection

    'コメント情報が設定されたシートのセルアドレス取得
    comment = objSheetComm.Range(cel.Address).Value

    'コメント追加
    With objSheet.Range(cel.Address)
     'コメント追加
       .AddComment comment
     'コメントを表示状態に変更
       .comment.Visible = True
     'コメントの大きさを文字サイズに自動サイズ調整
       .comment.Shape.TextFrame.AutoSize = True
    End With

 Next

End With

' 各種オブジェクトClose(後処理)
' これやっとかないと、ゴミが残る。
objSheet.Select
objBook.Save
objBook.Close
ExcelApp.Quit
Set objBook = Nothing
Set objSheet = Nothing
Set objSheetComm = Nothing

endMsg()


'読み込みファイル指定ダイアログ表示
Function inFileMsg(){
 if vbCancel = MsgBox( "以下のファイルのコメント処理します。" & vbCrLf &_
                       "よろしいですか?" & vbCrLf & vbCrLf &_
                       fullFName,_
                       vbOKCancel, "Excelコメント付与" ) then
        WScript.Quit
 end if
}

'終了メッセージ出力
Function endMsg(){
 MsgBox "処理が終了しました。",,"Excelコメント付与"
 end if
}

イケてないソースだけど、サンプルってことでお許しを・・・

他にも、Web画面操作したり出来るみたいなので、使い勝手良さそう。
今後のツール作りは、これで行きたいと思います。
もっと、早く調べておけばよかった・・・
ダメだな~、面倒臭がっちゃ。。。

 - Excel(機能・VBA), プログラミング

ad

ad

Message

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

  関連記事