Excelが大好きだ!

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


スポンサードリンク

他社に送る書類からメモ・コメントを一時的に退避させる(1.退避 別ブックにメモ・コメントを転記。メモ・コメントの一括削除)

資料を他社に送る時に気をつけないといけないのが

コメントの記載です。

自社内ならともかく他社の方に見られるとちょっとまずい内容が書かれていることが多々あります。

送付用にブックをコピーしてコメントを削除してから送信したりしていますが、この時期は数が多くてめんどくさくなってきました。

そこで

Excelブックから全てのコメントを一時的に退避させる

・退避させたコメントを元のセルに復旧させる

以上の機能にチャレンジしてみます。

今回はまずコメントを退避させるところまで。

コード

Sub CommentExport()
     Dim myWS As Worksheet
     Dim myRng As Range
     Dim myRngs As Range
     Dim myWB As Workbook
     Dim CommentWB As Workbook
     Dim i As Long
     
'###コメントのExport
Application.ScreenUpdating = False
     Set myWB = ActiveWorkbook
     Set CommentWB = Workbooks.Add
     i = 1
     Cells(i, 1).Value = "コメント"
     Cells(i, 2).Value = "シート名"
     Cells(i, 3).Value = "アドレス"
     Cells(i, 4).Value = "コメント内容"
     i = i + 1
     
On Error GoTo err
     For Each myWS In myWB.Worksheets
          Set myRngs = myWS.Range("A1").SpecialCells(xlCellTypeComments)
          For Each myRng In myRngs
               myRng.Copy
               With CommentWB.Worksheets(1)
                    .Cells(i, 1).PasteSpecial Paste:=xlPasteComments
                    .Cells(i, 2).Value = myWS.Name
                    .Cells(i, 3).Value = myRng.Address
                    .Cells(i, 4).Value = myRng.Comment.Text
               End With
               i = i + 1
          Next
          
'###既存コメントの削除。念の為コメントアウト
'          myRngs.ClearComments
err:
     Resume err1
err1:
     Next
     Dim SaveFileName As String
     SaveFileName = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1)
     
     CommentWB.Close True, ThisWorkbook.Path & "\" & SaveFileName & _
          "_comment" & WorksheetFunction.Text(Now(), "hhmmdd") & ".xlsx"
Application.ScreenUpdating = True
End Sub  

処理としては以下のよう流れ

①.コメント退避用の新規ブックを作成

②.全シートのコメントを退避用ブックにコピー

③.元のブックのコメントを全て削除


①に関しては元のブックにコメントがあろうが無かろうが新規ブックを作る流れになっている。このマクロを呼び出す時はコメントを移動させたい時のハズという前提。

但し、コメントが無い状態でマクロを実行ししてもエラーが発生しないようにOn Error Goto及びResumeで対策している。

ループ処理の中でOn Error Resumeを使用してもそのままでは初回のエラーしか検知しないため、Resume句を使用している。(がいまいちこの辺りの原理がわかっていないので個人的に要勉強)

②元のブックでジャンプ機能を利用してコメント付与セルのみ抽出。抽出したコメントを単純にコピーして退避用ブックにペースト。

その際に復元用の情報として
・シート名
・セルアドレス
・コメント内容(復元には使用しないが)

の情報を一緒に転記しておく。

コメントが無い場合にエラーが発生するのはジャンプ機能(Speciallcells)のところだが、上述のようにOn Error Resumeで対策をしている。

③で元のブックのコメントを全て削除している。念の為コメントアウトしているので、コメントを削除する場合はコメントアウトを削除してください。
※使用した結果どうなっても責任は取れませんが

以上①~③の処理を全シートに対して行い処理が終了。

実行後の転記用Excelはこんな感じです。

まとめ

コメントを別ブックに退避させ元のブックからコメントを削除するところまで無事に作成することが出来ました。

作ってみるとコメントを削除する機能を使用しなくても、こうやって一覧で見れるのも中々面白いなと思いました。

くどいようですが、内容を実行してコメントが忘却の彼方に消え去っても責任は取れませんのであしからず

※しかしこういうのって皆さんどうやって対策してるんだろう。