【Word VBA】英文特許明細書の段落番号を太字にするWordマクロ

セミナーの受講生から、特許明細書の段落番号（半角の角括弧で囲まれた4桁数字）を1つずつ太字にしていると聞きました。クライアントによってはそのような作業があるのですね。

この処理を自動化するためにマクロを作ってみました。英文明細書用です。

このマクロでできること

（マクロ実行前）

段落番号の前にタブや半角スペース、インデントがある場合を想定しています。

（マクロ実行後）

段落番号だけを太字・蛍光ペンで処理します。

マクロの解説

ワイルドカードを使って段落番号を探します。見つかったら太字にして蛍光ペンで着色します。

まず最初の処理で、段落番号の前にスペースやタブ記号がある場合を対象にします（13行目）。

検索する文字列：^13[　 ^t]{1,}\[[0-9]{4}\]

特許明細書の段落番号は段落の先頭に記載されているので、改行記号（^13）から始まる記述となります。改行記号のあとにタブやスペースが1つ以上あるという記述です。

2つ目の処理で、段落番号の前にスペースやタブがない場合を対象にします（42行目）。

検索する文字列：^13\[[0-9]{4}\

太字にしたり着色したりするのは段落番号の箇所だけなので、SetRange メソッドで範囲を設定します。

あと、29行目と58行目のCollapse メソッドは今回のプログラムではなくてもいいのですが、癖として書くようにすればいいと思います。これを書いておくと、想定していなかった無限ループを回避できます。

また、30行目と59行目のDoEvents 関数もなくてもいいのですが、ある方が処理が安定すると思います。特に長い文書の一括処理をする場合には必須です。

マクロ

Sub 特許段落番号を太字化_英文()

　Dim myRange As Range

　'-------------------------------------------
　'処理1　段落先頭にスペースがある場合
　'-------------------------------------------
　'オブジェクト変数の設定
　Set myRange = ActiveDocument.Range(0, 0)
　
　'太字化
　With myRange.Find
　　.Text = "^13[　 ^t]{1,}\[[0-9]{4}\]"
　　.Forward = True
　　.Wrap = wdFindStop
　　.Format = False
　　.MatchCase = False　　　　 '大文字と小文字の区別する
　　.MatchWholeWord = False　　'完全に一致する単語だけを検索する
　　.MatchByte = False　　　　 '半角と全角を区別する
　　.MatchAllWordForms = False '英単語の異なる活用形を検索する
　　.MatchSoundsLike = False　 'あいまい検索（英）
　　.MatchFuzzy = False　　　　'あいまい検索（日）
　　.MatchWildcards = True　　'ワイルドカードを使用する
　　Do While .Execute = True
　　　With myRange
　　　　.SetRange .End - 6, .End '範囲を段落番号に設定
　　　　.Font.Bold = True　'太字
　　　　.HighlightColorIndex = wdBrightGreen　'蛍光ペン：明るい緑
　　　　.Collapse wdCollapseEnd
　　　　DoEvents
　　　End With
　　Loop
　End With

　'-------------------------------------------
　'処理2　段落先頭にスペースがない場合
　'-------------------------------------------
　'オブジェクト変数の設定
　Set myRange = ActiveDocument.Range(0, 0)
　
　With myRange.Find
　　.Text = "^13\[[0-9]{4}\]"
　　.Forward = True
　　.Wrap = wdFindStop
　　.Format = False
　　.MatchCase = False　　　　 '大文字と小文字の区別する
　　.MatchWholeWord = False　　'完全に一致する単語だけを検索する
　　.MatchByte = False　　　　 '半角と全角を区別する
　　.MatchAllWordForms = False '英単語の異なる活用形を検索する
　　.MatchSoundsLike = False　 'あいまい検索（英）
　　.MatchFuzzy = False　　　　'あいまい検索（日）
　　.MatchWildcards = True　　'ワイルドカードを使用する
　　Do While .Execute = True
　　　With myRange
　　　　.SetRange .End - 6, .End '範囲を段落番号に設定
　　　　.Font.Bold = True　'太字
　　　　.HighlightColorIndex = wdBrightGreen　'蛍光ペン：明るい緑
　　　　.Collapse wdCollapseEnd
　　　　DoEvents
　　　End With
　　Loop
　End With
　
　'-------------------------------------------
　'後処理
　'-------------------------------------------
　Set myRange = Nothing

End Sub