【Word VBA】コメントを書き出すWordマクロ(その6)対象となる文を取得

先日のWordマクロ活用セミナーの参加者からご要望があり作ってみました。やっぱりセミナーをすると現場の具体的な課題がでてきて楽しいですね。

これまで紹介してきたマクロ(【コード】コメントを書き出すWordマクロ(その5) ページ番号・行番号・作者名付きなど)では、コメントが付与されている箇所のみを書き出していました。この場合には、このコメントがどのような文脈で使われているものなのか判断ができません。

もしコメントが添えられた箇所の文脈が見えると、コメントの一覧表の価値が上がりますね。用途も広がります。

今回の記事では、セミナーを受講いただいたあきーらさんからのご要望で、コメントを書き出す際にコメントの対象文を書き出すように改良してみました。

こちらもチェック! 
コメントの自動挿入・一覧表示は「色deチェック」におまかせ

このマクロでできること

以下のように複数の人がコメントを挿入した文書があります。この文書に対してマクロを実行します。

新規ファイルに一覧表が作成されます。コメントが残された箇所は蛍光ペンで着色され、その1文全体が取得されています。

応用技

このマクロで使われているFormattedTextプロパティはかなり強力で、文字だけではなく画像や表も取得できます。画像にコメントを挿入した場合には、このマクロを使うとこの画像を一覧表に取得できるということです。

特定の画像だけを別ファイルに取得する際に役に立つかもしれません。ぜひお試しください。

マクロの解説

これまでに作成してきたコメントの抽出マクロとほとんど同じです。以下、いくつかの新しいアプローチを紹介します。

コメント挿入箇所の1文の取得方法

基本的な考え方は、RangeオブジェクトExpandメソッドを使って範囲を文単位に拡大するということです。

CommentオブジェクトScopeプロパティ(コメントが挿入されている箇所)が返すのはRangeオブジェクトなので、このScope箇所をオブジェクト変数を設定します(41行目)。

RangeオブジェクトになればExpandメソッドを使い1文に範囲を広げられます(42行目)。

コメント挿入箇所を蛍光ペンで着色する方法

今回のように1文を取得すると、取得した文中でどの言葉がコメントの対象なのかを示す必要があります。私は以下の手順で、コメントが付与された箇所を蛍光ペンで着色するようにしてみました。

  1. コメント付きの1文を取得して対訳表を作成
  2. 対訳表のコメント箇所を蛍光ペンで着色しコメントを削除

まず、「1.コメント付きの1文を取得して対訳表を作成」の方法ですが、FormattedTextプロパティを用いました(43行目)。

このようにすると、文章をテキスト情報だけではなく、書式情報を含むテキスト情報で取得しています。結果的にコメントも含めて取得できます。

「2.対訳表のコメント箇所を蛍光ペンで着色しコメントを削除」の方法ですが、56行目~63行目に記載の通りです。60行目の設定を変えれば、下線を引いたり文字色を変えたり太字にしたり、好きな文字書式をマーカーとして利用できます。

マクロ


Sub コメントを別紙に書き出すマクロ_6()

 Dim i As Integer
 Dim actDoc As Document
 Dim newDoc As Document
 Dim myTable As Table
 Dim myRange As Range
 
 If ActiveDocument.Comments.Count = 0 Then Exit Sub
 If MsgBox("ファイル内のすべてのコメントを書き出しますか?", _
   vbQuestion Or vbYesNo, "実施前の確認") = vbNo Then
  Exit Sub
 End If
 
 'オブジェクト変数の設定
 Set actDoc = ActiveDocument
 Set newDoc = Documents.Add
 Set myTable = newDoc.Tables.Add(Range:=Selection.Range, _
       NumRows:=actDoc.Comments.Count + 1, NumColumns:=5)
       
 '表の項目を追記
 With myTable
  .Cell(1, 1).Range.Text = "P."
  .Cell(1, 2).Range.Text = "行"
  .Cell(1, 3).Range.Text = "対象部分(蛍光ペンで着色)"
  .Cell(1, 4).Range.Text = "作成者"
  .Cell(1, 5).Range.Text = "コメント"
  With .Rows(1).Range
   .ParagraphFormat.Alignment = wdAlignParagraphCenter
   .Collapse direction:=wdCollapseStart
  End With
 End With
 
 'ページ番号とコメントを表に記入
 For i = 1 To actDoc.Comments.Count
  With actDoc.Comments(i)
   myTable.Cell(i + 1, 1).Range.Text = _
    .Scope.Information(wdActiveEndPageNumber)
   myTable.Cell(i + 1, 2).Range.Text = _
    .Scope.Information(wdFirstCharacterLineNumber)
   Set myRange = .Scope
   myRange.Expand wdSentence
   myTable.Cell(i + 1, 3).Range.FormattedText = myRange
   myTable.Cell(i + 1, 4).Range.Text = .Author
   myTable.Cell(i + 1, 5).Range.Text = .Range.Text
  End With
 Next i
 
 '表のスタイルを設定
 With myTable
  .Style = "表 (格子)"
  .AutoFitBehavior (wdAutoFitContent)
 End With
 
 '表のコメントを蛍光ペン(黄色)に変換
 Dim myComment As Comment
  
 For Each myComment In myTable.Range.Comments
  With myComment
   .Scope.HighlightColorIndex = wdYellow
   .Delete
  End With
 Next
 newDoc.UndoClear
 newDoc.Activate
 
 'オブジェクト変数の解放
 Set actDoc = Nothing
 Set newDoc = Nothing
 Set myTable = Nothing
 Set myRange = Nothing

End Sub

関連記事

トップへ戻る