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

2018年5月12日

セミナーの受講生から、特許明細書の段落番号(半角の角括弧で囲まれた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

-コード
-, ,