「これ、特許明細書の段落番号でコメントの位置を特定できるといいですね。」
ようやくつくりました！
請求項も探す場合にはもう一工夫必要ですが、このマクロをヒントにしてつくってみてください。
▼このマクロでできること
文書中に挿入されたコメントを新規文書に書き出します。
文書中のコメントは残されたままです。
たとえば、【０００６】段落の4行目の「ハイブリッド自動車」に「コメント１」が挿入され、【０００７】段落の2行目から3行目にかけた「電力の種類」に「コメント２」が挿入されています。
マクロを実行すると、以下のように新規文書に記載されます。
▼マクロの解説
コメントが挿入された箇所を見つけると、その対象となる部分が.Scopeプロパティにて指定されます。
この.Scopeプロパティは、Rangeオブジェクトです。
よって、文字の位置を指定することができるわけですね。
.Scope.Start とすれば、対象となる文字列の開始位置を取得できます。
このようにして取得した位置から上方向に段落番号を検索します。
そうすれば、このコメントが書かれた段落番号を取得できるはずです。
ちなみに、段落番号は、以下のワイルドカードの検索式で探します。
"^13[ ^t[【[]{1,}[0-9０-９]{4}[]】］]"
つまり、段落の先頭に記載されており、
その後に、半角スペース、全角スペース、タブ、【、［（全角）、[（半角）、のうちいずれかが1つ以上記載されており、
その後に、4桁の数字（全角又は半角）が記載され
最後に、】、]（全角）、]（半角）で閉じられている、
ということです。
結果、
□【０００５】
（タブ）［０００５］
_[0005]
など、様々な記載の段落番号を取得できます。（上記で、□は全角スペース、_ は半角スペース）
▼マクロ
Sub コメント_別紙に書き出す_特許段落番号を入れる()
Dim i As Integer
Dim actDoc As Document
Dim newDoc As Document
Dim myTable As Table
Dim myRange As Range
Dim myLine As Integer
If ActiveDocument.Comments.Count = 0 Then Exit Sub
'オブジェクト変数の設定
Set actDoc = ActiveDocument
Set newDoc = Documents.Add
Set myTable = newDoc.Tables.Add(Range:=Selection.Range, _
NumRows:=actDoc.Comments.Count + 1, NumColumns:=4)
'表の項目を追記
With myTable
.Cell(1, 1).Range.Text = "段落番号"
.Cell(1, 2).Range.Text = "行"
.Cell(1, 3).Range.Text = "対象部分"
.Cell(1, 4).Range.Text = "コメント"
.Rows(1).Select
With Selection
.ParagraphFormat.Alignment = wdAlignParagraphCenter
.Collapse direction:=wdCollapseStart
End With
End With
'段落番号検索用のRangeオブジェクトの設定
Set myRange = actDoc.Range(0, 0)
With myRange.Find
.Text = "^13[ ^t[【[]{1,}[0-9０-９]{4}[]】］]"
.Forward = False
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
'ページ番号とコメントを表に記入
For i = 1 To actDoc.Comments.Count
With actDoc.Comments(i)
myRange.SetRange Start:=.Scope.Start, End:=.Scope.Start
If myRange.Find.Execute = True Then
myRange.Start = myRange.Start + 1
myTable.Cell(i + 1, 1).Range.Text = myRange.Text
myLine = myRange.Information(wdFirstCharacterLineNumber)
End If
myTable.Cell(i + 1, 2).Range.Text = _
.Scope.Information(wdFirstCharacterLineNumber) - myLine
myTable.Cell(i + 1, 3).Range.Text = .Scope.Text
myTable.Cell(i + 1, 4).Range.Text = .Range.Text
End With
Next i
'表のスタイルを設定
With myTable
.Style = "表 (格子)"
.AutoFitBehavior (wdAutoFitContent)
End With
'オブジェクト変数の解放
Set actDoc = Nothing
Set newDoc = Nothing
Set myTable = Nothing
Set myRange = Nothing
End Sub
▼関連記事
【Wordマクロ】特許に関連したマクロ一覧
コメントを書き出すマクロ
ページ番号とともにWordのコメントを書き出す
コメントを書き出すマクロ（ページ番号・行番号付き）
初めての方へ（ブログの目次）
Wordマクロの便利な使い方一覧（１）
Wordマクロの便利な使い方一覧（２）
Wordマクロの便利な機能一覧（１）
Wordマクロの便利な機能一覧（２）