【Word VBA】Symbolフォントの段落番号を通常の段落番号に変換するWordマクロ

今担当している英日特許翻訳の案件で、おかしなことが起こりました。

今まで使っていた段落番号の連番処理のマクロが動かないのです。

特許文献で段落番号を[ 0001] のように記載しますが、この角括弧や数字がSymbolフォントで記載されていたのです。

Symbolフォントの角括弧や数字は見た目はほとんど変わらないのですが、文字コードが通常の角括弧とは異なるため、Enterキーの左側にある[や]と通常の数字を使っても検索できません。

試しに以下のように0を探しましたが無理でした。

ですから、特許の段落番号にこのSymbolフォントが用いられていると、通常の角括弧を用いて作成した段落番号の連番処理マクロが実行できなくなってしまいます。

そのようなわけで、Symbolの角括弧や数字を通常の角括弧や数字に変換するマクロを作成しました。

Wordで動く翻訳チェックソフト「色deチェック」 や上書き翻訳用の一括置換ソフト「ぱらぱら 」など、他のマクロにも組み込んでいきます。

このマクロでできること

Symbolフォントで記載された角括弧と数字を、Times New Roman の角括弧と数字に変換します。
書き換えた文字列を明るい緑色の蛍光ペンで着色します。

マクロの解説

SymbolフォントのUnicodeの番号を取得するために、Finding and replacing symbols に記載されている以下のマクロを使いました。

Sub GetCharNoAndFont()

　With Dialogs(wdDialogInsertSymbol)
　　Debug.Print "Font: " & .Font
　　Debug.Print "Char number " & .CharNum
　End With

End Sub

イミディエイトウィンドウにフォント名とUnicodeが表示されます。

これを元に、Symbolフォントの角括弧を特定します。

Finding and replacing symbols の記事に記載されているとおり、Unicodeだけでも文字列を特定できるのですが、Symbol以外の他のフォントとUnicode番号がかぶっている場合があるので、念のためにフォント名まで調べてから通常の角括弧や数字に書き換えています（41行目～45行目）。

なお、フォント名を調べるためには文字列を選択する必要がありますので、Rangeオブジェクトを一度選択して（Selectionオブジェクトにして）実行しています（40行目）。

マクロ

Sub Symbolの角括弧と数字をTimesNewRomanフォントに変換する()

　Dim myRange As Range
　Dim myString As String

　'Symbolフォントの文字列
　'ChrW(-4005)　'[
　'ChrW(-4003)　']
　'ChrW(-4039) '9
　'ChrW(-4040) '8
　'ChrW(-4041) '7
　'ChrW(-4042) '6
　'ChrW(-4043) '5
　'ChrW(-4044) '4
　'ChrW(-4045) '3
　'ChrW(-4046) '2
　'ChrW(-4047) '1
　'ChrW(-4048) '0

　'画面の更新をオフ（ちらつき防止）
　Application.ScreenUpdating = False

　myString = ChrW(-4005) & "[" & ChrW(-4048) & "-" & ChrW(-4039) & "]{4}" & ChrW(-4003)
　
　Set myRange = ActiveDocument.Range(0, 0)

　With myRange.Find
　　.Text = myString　'検索する文字列
　　.Forward = True
　　.Wrap = wdFindStop
　　.Format = False　　　　'書式：オフ
　　.MatchCase = False　　'大文字と小文字の区別する：オフ
　　.MatchWholeWord = False　'完全に一致する単語だけを検索する：オフ
　　.MatchByte = False　　'半角と全角を区別する：オフ
　　.MatchAllWordForms = False '英単語の異なる活用形を検索する：オフ
　　.MatchSoundsLike = False　 'あいまい検索（英）：オフ
　　.MatchFuzzy = False　　'あいまい検索（日）：オフ
　　.MatchWildcards = True　'ワイルドカードを使用する：オン
　　Do While .Execute
　　　myRange.Select
　　　If Dialogs(wdDialogInsertSymbol).Font = "Symbol" Then
　　　　'フォントの変換
　　　　myRange.Font.Name = "Times New Roman"
　　　　myRange.HighlightColorIndex = wdBrightGreen
　　　End If
　　　myRange.Collapse wdCollapseEnd
　　Loop
　End With

　'カーソルを文書先頭に移動
　ActiveDocument.Range(0, 0).Select

　Set myRange = Nothing

　'画面の更新をオン（元に戻す）
　Application.ScreenUpdating = True

End Sub

関連記事

Finding and replacing symbols