Excelが大好きだ!

Excel大好き経理マンがExcelの事を書き綴っていきます。


スポンサードリンク

他社に送る書類からメモ・コメントを一時的に退避させる(2.復元)

前回はコメントを全て別ブックに退避させてから、全て削除するところまでを実現させました。

今回は退避させたコメントを元のブックに復元させるところまでを検証してみます。

コード

Sub CommentInport()
   Dim FilePath As Variant
   Dim myWB As Workbook
   Set myWB = ActiveWorkbook
   Dim CommentWB As Workbook
   FilePath = Application.GetOpenFilename("2007Excelファイル(*.xlsx),*.xlsx")
   
   'ダイアログでキャンセルをした場合に処理を中止する。
   'それ以外は選択したExcelファイルを開いて処理を続行。
   If VarType(FilePath) = vbBoolean Then Exit Sub
   Set CommentWB = Workbooks.Open(FilePath)
   
   Dim myVar As Variant
   Dim i As Long

   myVar = CommentWB.Worksheets(1).Range("A1").CurrentRegion
   
   For i = 2 To UBound(myVar)
        CommentWB.Worksheets(1).Cells(i, 1).Copy
        myWB.Worksheets(myVar(i, 2)).Range(myVar(i, 3)).PasteSpecial (xlPasteComments)
   Next i
   Application.CutCopyMode = False
   CommentWB.Close
End Sub

処理の流れは

①コメントを保存したブックをGetOpenFilenameを利用して開く
②退避用ブックのコメントをコピーして、復元用情報を参照して元のブックにコピーのみを貼り付ける。
③退避用ブックを閉じる

①GetOpenFileNameはファイルを選択した場合はフルパスを、キャンセルをした場合はFalse型を返す。Flaseが返ってきた場合は以降の処理が継続できないので返り値がBoolean型がどうかを判定して処理を中断している。


②退避用ブックに貼り付けてあるコメントを順番にコピーして、復元情報(シート名・セルアドレス)を元にマクロ実行時のアクティブブックにコメントを貼り付けていく。

この時アクティブブックの貼り付けセルにコメントがある場合は上書きされるので要注意。
※例のごとくこの処理でコメントが失われても責任は持てません

あと、残念ながらコメント退避に使用したブック以外を開いた場合・退避させた時とシート名が異なっている場合等の処理はしておりませんので、その場合はエラーで止まります。

③退避用ブックでコピーモードのままなので念の為、CutCopyModeをFalseにしてから退避用ブックを閉じる

まとめ

無事に当初想定していた、コメントの退避からの復元まで無事に実現させることが出来ました。

コメント退避の機能についてはコメントを一覧で管理することが出来るという副産物が生み出されましたので、コメントの削除のするしないのフラグを立てれるようにするつもりです。

後は実践使用してブラッシュアップ及びアドバイス頂いた内容を反映した改良版をその内に発表したいと思います。