【Word VBA】特定のコメント挿入者名を変更するWordマクロ

2021年6月25日

, ,

以前、「【コード】コメントの挿入者名を変更するWordマクロ」にて文書内のすべてのコメントの挿入者名（コメント者名）を変更するマクロを紹介しました。

今回は、特定のコメントについて名前を変更するマクロを紹介します。

このマクロでできること

以下のような、複数名がコメントしている文書があります。

この状態でマクロを実行します。すると以下のダイアログが表示されます。ここには、このファイルの作者名が自動的に表示されます。

変更対象となるコメント者名が別の名前の場合には修正してください。

［OK］ボタンをクリックし、次のダイアログで変更後の名前を入力します。「校閲者」と入力しました。

そして、次のダイアログでイニシャルを入力します。「AA」としました。

これで［OK］ボタンをクリックすると、文書全体で対象に特定した箇所だけコメント者名が変更されます。

マクロの解説

元に戻しやすいようにUndoRecordを使っています。

文書の「作者名」は22行目の ActiveDocument.BuiltInDocumentProperties("author") で取得しています。この値は、以下のようにバックステージビューの［情報］のページに表示されているものです。

この値を初期値（Default値）としてInputBoxに表示しています。

36行目～44行目で入力した情報に基づいてコメントの挿入者名を修正します。

マクロ


Sub 特定のコメント挿入者名を変更するWordマクロ()
　
　Const myTitle As String = "コメント者名の変更"
　
　'-------------------------------------------
　'UndoRecordの利用
　'-------------------------------------------
　#If VBA7 Then
　　Dim objUndo As UndoRecord
　　Set objUndo = Application.UndoRecord
　　objUndo.StartCustomRecord myTitle
　#End If

　'-------------------------------------------
　'情報の入力
　'-------------------------------------------
　Dim myName1 As String '変更対象のコメント者名
　Dim myName2 As String '変更後のコメント者名
　Dim myInitial As String '変更後のコメント者イニシャル
　
　myName1 = InputBox("変更対象のコメント者名を入力してください。", myTitle, _
　　　　　　　　　　 ActiveDocument.BuiltInDocumentProperties("author"))
　If myName1 = vbNullString Then Exit Sub
　
　myName2 = InputBox("変更後のコメント者名を入力してください。", myTitle)
　If myName2 = vbNullString Then Exit Sub
　
　myInitial = InputBox("変更後のコメント者のイニシャルを入力してください。", myTitle)
　If myInitial = vbNullString Then Exit Sub
　　　　　　　　　　 
　'-------------------------------------------
　'コメント者名の変更処理
　'-------------------------------------------
　Dim myComment As Comment
　
　For Each myComment In ActiveDocument.Range.Comments
　　With myComment
　　　If .Author = myName1 Then
　　　　.Author = myName2
　　　　.Initial = myInitial
　　　End If
　　End With
　　DoEvents
　Next
　
　'-------------------------------------------
　'UndoRecordの利用
　'-------------------------------------------
　#If VBA7 Then
　　objUndo.EndCustomRecord
　　Set objUndo = Nothing
　Application.ScreenRefresh
　#End If
　
　MsgBox "変更が終わりました。", vbInformation, myTitle
　
End Sub

関連記事

-コード
-, ,