かつて紹介した「【コード】コメントを書き出すWordマクロ(その3) ページ番号付き 」を特許明細書用に改良しました。
最近の翻訳案件で、Word文書に挿入したコメントを別紙に書き出す際、特許用の段落番号(括弧で囲まれた4桁の数字)が表示されると便利だと感じました。
上書き翻訳ツールを使って翻訳をする場合、バイリンガルファイルにコメントを挿入しながら翻訳を進めます。
このときに挿入したコメントを書き出す際に挿入されるページ番号や行番号は、バイリンガルファイルのものとなります。
したがって原文や訳文のページ番号・行番号とは異なるため、クライアントに提出する際に意味を成しません。
そこで、今回のマクロでは、コメントを挿入した箇所の段落番号や見出しを一覧表に表示するようにしました。
今後、関連するアドイン(上書き翻訳ツール、ベリーベンリなマクロ集など)に本機能を追加していきます。
最近紹介した「【コード】カーソルがある箇所の特許段落番号を取得するWordマクロ 」でも同じ考え方のコードを使っています。
このマクロでできること
特許明細書中にコメントがある場合、コメントが挿入されている段落番号や見出しを書き出します。上書き翻訳ツールでバイリンガルファイルになっている場合にも同様に使えます。
実行前
実行後
マクロの解説
上記の表のとおり、5列目に段落番号を挿入します。
42行目で、GetHeading のファンクションを呼び出して段落番号を取得します。
これ以外は、これまで紹介したマクロと同じです。
マクロ
Sub コメント書出し_特許() Dim i As Integer Dim actDoc As Document Dim newDoc As Document Dim myTable As Table If ActiveDocument.Comments.Count = 0 Then MsgBox "このファイルにはコメントがありません。終了します。", vbInformation, "お知らせ" 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 = "段落" .Rows(1).Select With Selection .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) myTable.Cell(i + 1, 3).Range.Text = .Scope.Text myTable.Cell(i + 1, 4).Range.Text = .Range.Text myTable.Cell(i + 1, 5).Range.Text = GetHeading(.Scope) End With Next i '表のスタイルを設定 With myTable .Style = "表 (格子)" .AutoFitBehavior (wdAutoFitContent) End With 'オブジェクト変数の解放 Set actDoc = Nothing Set newDoc = Nothing End Sub Function GetHeading(myRange As Range) As String Dim myPara As Paragraph Dim myParaRange As Range Set myPara = myRange.Paragraphs(1) Do If myPara Is Nothing Then myParaRange.SetRange 0, 0 Exit Do End If Set myParaRange = myPara.Range myParaRange.MoveStartWhile Cset:=vbTab & Chr(32) & Chr(-32448) If myParaRange.Characters.First.Text Like "[【^[]" Then myParaRange.MoveEndUntil Cset:="】]", Count:=wdBackward Exit Do Else Set myPara = myPara.Previous End If Loop GetHeading = myParaRange.Text Set myPara = Nothing Set myParaRange = Nothing End Function