【Word VBA】ギリシャ文字をシンボルフォントに変更するWordマクロ

2013年11月22日

, , 
2017-08-19
本記事のコードに間違いが見つかりましたので修正しました。
「【コード】ギリシャ文字をシンボルフォントに変更するWordマクロ（その２）」を
ご覧ください。

特許翻訳の日英翻訳時に、ギリシャ文字をシンボルフォントにするように指示されることがあるのではないでしょうか。

これはお客様によって処理が異なると思われます。

今回のマクロは、日本語の中にあるギリシャ文字を、シンボルフォントのギリシャ文字に自動的に変換するマクロです。

ギリシャ文字の取り扱いはご注意ください。

シンボルフォントの文字は、他のフォントを設定したときに文字化けしてしまいます。あくまでも、シンボルフォントにしているのでギリシャ文字として表示されています。

このマクロでできること

文書中のギリシャ文字（日本語フォント、英語フォント）を探し、シンボルフォントのギリシャ文字に書き換えます。

書き換えた箇所は、明るい緑の蛍光ペンで着色します。

（実行前）

（実行後）

マクロの解説

2つマクロを掲載しました。

後半に、置換を使ったマクロを掲載しますが、これはうまくいかないことがあります。参考のために掲載しました。

別のアプリケーションからギリシャ文字をWordに貼り付けた場合に、フォント名をシンボルフォントに置換（置換後の文字列のフォントを「Symbol」に設定: マクロ2の80行目）をしてもシンボルフォントとして表示されないことがありました。全角のまま（例えば、MSゴシックのまま）であるため、文字化けしてしまうのです。

（文字化け例）


よって、少し面倒ですが、ギリシャ文字を見つけたらその文字を半角に変換（文字種の変換）します。その後、フォント名をシンボルフォントに設定し、その上でシンボルの文字を入力しています。（マクロ1の88～90行目）

ギリシャ文字の文字コードについては、水野麻子さんの以下のページを参考にさせていただきました。

マクロでは、16進数の値を用いています。

Word ギリシャ文字コード・ラテン文字対応表

マクロ1


Sub ギリシャ文字をシンボルフォントに変更する()

　Dim myRange As Range
　Dim myText As Variant
　Dim myChr(49) As String
　Dim i As Integer

　myChr(1) = "0391,F041"
　myChr(2) = "0392,F042"
　myChr(3) = "0393,F047"
　myChr(4) = "0394,F044"
　myChr(5) = "0395,F045"
　myChr(6) = "0396,F05A"
　myChr(7) = "0397,F048"
　myChr(8) = "0398,F051"
　myChr(9) = "0399,F049"
　myChr(10) = "039A,F04B"
　myChr(11) = "039B,F04C"
　myChr(12) = "039C,F04D"
　myChr(13) = "039D,F04E"
　myChr(14) = "039E,F058"
　myChr(15) = "039F,F04F"
　myChr(16) = "03A0,F050"
　myChr(17) = "03A1,F052"
　myChr(18) = "03A3,F053"
　myChr(19) = "03A4,F054"
　myChr(20) = "03A5,F055"
　myChr(21) = "03A6,F046"
　myChr(22) = "03A7,F043"
　myChr(23) = "03A8,F059"
　myChr(24) = "03A9,F057"
　myChr(25) = "03B1,F061"
　myChr(26) = "03B2,F062"
　myChr(27) = "03B3,F067"
　myChr(28) = "03B4,F064"
　myChr(29) = "03B5,F065"
　myChr(30) = "03B6,F07A"
　myChr(31) = "03B7,F068"
　myChr(32) = "03B8,F071"
　myChr(33) = "03B9,F069"
　myChr(34) = "03BA,F06B"
　myChr(35) = "03BB,F06C"
　myChr(36) = "03BC,F06D"
　myChr(37) = "03BD,F06E"
　myChr(38) = "03BE,F078"
　myChr(39) = "03BF,F06F"
　myChr(40) = "03C0,F070"
　myChr(41) = "03C1,F072"
　myChr(42) = "03C3,F073"
　myChr(43) = "03C4,F074"
　myChr(44) = "03C5,F075"
　myChr(45) = "03C6,F066"
　myChr(46) = "03C7,F063"
　myChr(47) = "03C8,F079"
　myChr(48) = "03C9,F077"
　myChr(49) = "03C2,F076"

　'画面の更新をオフ
　Application.ScreenUpdating = False
　
　'置換用のRangeオブジェクトを設定（ストーリーは本文）
　Set myRange = ActiveDocument.Range(0, 0)

　For i = 1 To 49
　
　　'「検索する文字列」と「置換後の文字列」の
　　'文字コードの読み込み
　　myText = Split(myChr(i), ",")
　
　　'文書の先頭から検索を開始
　　myRange.SetRange 0, 0
　
　　With myRange.Find
　　　.Text = ChrW("&H" & myText(0))
　　　.Forward = True
　　　.Wrap = wdFindStop
　　　.Format = False
　　　.MatchWholeWord = False　　 '完全に一致する単語だけを検索する
　　　.MatchAllWordForms = False　'英単語の異なる活用形を検索する
　　　.MatchSoundsLike = False　　'あいまい検索（英）
　　　.MatchFuzzy = False　　　　 'あいまい検索（日）
　　　.MatchWildcards = False　　 'ワイルドカードを使用する
　　　.MatchByte = True　　　　　 '半角と全角を区別する
　　　.MatchCase = True　　　　　'大文字と小文字の区別する
　　　Do While .Execute = True
　　　　With myRange
　　　　　.HighlightColorIndex = wdBrightGreen '「明るい緑」の蛍光ペン
　　　　　.CharacterWidth = wdWidthHalfWidth　'半角に変換
　　　　　.Font.Name = "Symbol"　'シンボルフォントに設定
　　　　　.Text = ChrW("&H" & myText(1))　'文字の入力
　　　　　.Collapse Direction:=wdCollapseEnd　'選択解除
　　　　End With
　　　　DoEvents
　　　Loop
　　End With
　
　Next i
　　
　'Rangeオブジェクトの解放
　Set myRange = Nothing

　'画面の更新をオン
　Application.ScreenUpdating = True

End Sub

マクロ2（改良前・不備有り）


Sub ギリシャ文字をシンボルフォントに変更する2()
　'文字化けすることがあります。

　Dim myRange As Range
　Dim myText As Variant
　Dim myChr(49) As String
　Dim i As Integer
　Dim myColor As String
　
　myChr(1) = "0391,F041"
　myChr(2) = "0392,F042"
　myChr(3) = "0393,F047"
　myChr(4) = "0394,F044"
　myChr(5) = "0395,F045"
　myChr(6) = "0396,F05A"
　myChr(7) = "0397,F048"
　myChr(8) = "0398,F051"
　myChr(9) = "0399,F049"
　myChr(10) = "039A,F04B"
　myChr(11) = "039B,F04C"
　myChr(12) = "039C,F04D"
　myChr(13) = "039D,F04E"
　myChr(14) = "039E,F058"
　myChr(15) = "039F,F04F"
　myChr(16) = "03A0,F050"
　myChr(17) = "03A1,F052"
　myChr(18) = "03A3,F053"
　myChr(19) = "03A4,F054"
　myChr(20) = "03A5,F055"
　myChr(21) = "03A6,F046"
　myChr(22) = "03A7,F043"
　myChr(23) = "03A8,F059"
　myChr(24) = "03A9,F057"
　myChr(25) = "03B1,F061"
　myChr(26) = "03B2,F062"
　myChr(27) = "03B3,F067"
　myChr(28) = "03B4,F064"
　myChr(29) = "03B5,F065"
　myChr(30) = "03B6,F07A"
　myChr(31) = "03B7,F068"
　myChr(32) = "03B8,F071"
　myChr(33) = "03B9,F069"
　myChr(34) = "03BA,F06B"
　myChr(35) = "03BB,F06C"
　myChr(36) = "03BC,F06D"
　myChr(37) = "03BD,F06E"
　myChr(38) = "03BE,F078"
　myChr(39) = "03BF,F06F"
　myChr(40) = "03C0,F070"
　myChr(41) = "03C1,F072"
　myChr(42) = "03C3,F073"
　myChr(43) = "03C4,F074"
　myChr(44) = "03C5,F075"
　myChr(45) = "03C6,F066"
　myChr(46) = "03C7,F063"
　myChr(47) = "03C8,F079"
　myChr(48) = "03C9,F077"
　myChr(49) = "03C2,F076"

　'現在の蛍光ペンの色を保存
　myColor = Options.DefaultHighlightColorIndex
　
　'蛍光ペンの色を「明るい緑」に設定
　Options.DefaultHighlightColorIndex = wdBrightGreen
　
　'置換用のRangeオブジェクトを設定（ストーリーは本文）
　Set myRange = ActiveDocument.Range(0, 0)
　
　For i = 1 To 49
　　
　　'「検索する文字列」と「置換後の文字列」の
　　'文字コードの読み込み
　　myText = Split(myChr(i), ",")
　　
　　myRange.SetRange 0, 0
　　
　　With myRange.Find
　　　.Text = ChrW("&H" & myText(0))
　　　.Replacement.Text = ChrW("&H" & myText(1))
　　　.Replacement.Font.Name = "Symbol"　'シンボルフォントに設定
　　　.Replacement.Highlight = True
　　　.Forward = True
　　　.Wrap = wdFindStop
　　　.Format = True
　　　.MatchWholeWord = False　　 '完全に一致する単語だけを検索する
　　　.MatchAllWordForms = False　'英単語の異なる活用形を検索する
　　　.MatchSoundsLike = False　　'あいまい検索（英）
　　　.MatchFuzzy = False　　　　 'あいまい検索（日）
　　　.MatchWildcards = False　　 'ワイルドカードを使用する
　　　.MatchByte = True　　　　　 '半角と全角を区別する
　　　.MatchCase = True　　　　　'大文字と小文字の区別する
　　　.Execute Replace:=wdReplaceAll
　　End With
　　
　Next i
　
　DoEvents
　
　'蛍光ペンの色を元に戻す
　Options.DefaultHighlightColorIndex = myColor
　
　'Rangeオブジェクトの解放
　Set myRange = Nothing
　
End Sub

関連記事

過去の記事でシンボルフォントの検索方法を紹介しました。

以下の記事では、10進数にてシンボルフォントのギリシャ文字を示しているため、文字コードが61505から始まっています。

今回の記事では、16進数で示しているためF041などで示しています。

わかりにくくてすみません。

こうすればできる！！シンボルフォントの検索

こうすればできる！！シンボルフォントの検索（２）

こうすればできる！！シンボルフォントの検索（３）

Symbolフォントのギリシャ文字を蛍光ペンで着色するマクロ

-コード
-, ,