【Word VBA】文書内の外字を着色するWordマクロ

先日社内研修をさせていただいたお客様は外字を扱っていました。そういえば、このブログでは外字を取り扱ったことがありませんでした。というわけで簡単なサンプルコードを紹介します。

外字の問題点

Windowsでは外字エディターを利用して、文字コードで用意されていない特殊な文字を作成して登録できます。

ところが、この外字エディターで作成した外字は、そのパソコンでしか使えないのです。

たとえば、Unicodeで用意されていない51の丸数字を外字エディターで作りWordファイルに貼り付けました。

これを別のパソコンで開くと、以下のように文字化けしています。

というわけで、ファイル内に外字が使われているのか判定するマクロがあればいいなということです。

このマクロでできること

外字を明るい緑の蛍光ペンで着色します。

マクロの解説

外字の登録先を、Unicodeの文字コードで指定するとChrW(&HE000)～ChrW(&HE1FF)です。

外字エディターで登録されている文字を表示し、カーソルをあてると以下のように文字コードが表示されます。

UnicodeのU+E000と表示されています。

これをいつものワイルドカードで指定し、一括置換で着色します。

マクロ

Sub 外字を着色するマクロ()

　Dim myRange As Range
　Dim myColor As Integer
　
　'現在選択されている蛍光ペンの色の保存
　myColor = Options.DefaultHighlightColorIndex
　
　'蛍光ペンの色を設定（明るい緑）
　Options.DefaultHighlightColorIndex = wdBrightGreen
　
　Set myRange = ActiveDocument.Range(0, 0)
　
　'ワイルドカードをオンにして一括置換
　With myRange.Find
　　.Text = "[" & ChrW(&HE000) & "-" & ChrW(&HE1FF) & "]{1,}"
　　.Replacement.Text = ""
　　.Replacement.Highlight = True
　　.Forward = True
　　.Wrap = wdFindContinue
　　.Format = True
　　.MatchCase = False
　　.MatchWholeWord = False
　　.MatchByte = False
　　.MatchAllWordForms = False
　　.MatchSoundsLike = False
　　.MatchFuzzy = False
　　.MatchWildcards = True
　　.Execute Replace:=wdReplaceAll
　　DoEvents
　End With

　Set myRange = Nothing
　
　'蛍光ペンの色を元に戻す
　Options.DefaultHighlightColorIndex = myColor
　
End Sub

関連記事

外字の作り方について、以下の記事を参考にしました。

Windows7：外字の作り方 －教えて！HELPDESK　（外部リンク）