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

2017年8月19日 2025年7月18日

以前、「【コード】ギリシャ文字をシンボルフォントに変更するWordマクロ」を紹介しました。

通常フォントのギリシャ文字をSymbolフォントのギリシャ文字に変換するマクロです。

上記マクロでもSymbolフォントに変換できるのですが、1つ不具合がありました。

＜目次＞

不具合の内容

Symbolフォントで表示されているギリシャ文字を他のフォントで変換をしようとすると文字化けしてしまいます。

上記マクロでSymbolフォントに変換したαを選択してCenturyフォントに変換すると。。。

変換前：

変換後：

通常、記号系のフォントであるSymbolフォントは他の文字系のフォントで変換しようとしても文字化けをしません。このような文字化けが起こらないようにマクロを修正しました。

このマクロでできること

文字フォントで書かれたギリシャ文字をSymbolフォントに変換します。このSymbolフォントのギリシャ文字を選択して別の文字系のフォントに修正しようとしても変換されません。

（マクロ実行前）

（マクロ実行後）

変換箇所が明るい緑色の蛍光ペンで着色されます。

（Centuryフォントに変換）

表を選択して選択範囲をCenturyフォントを変換しようとしますが、Symbolフォントは文字化けしません。

マクロの解説

「【コード】ギリシャ文字をシンボルフォントに変更するWordマクロ」の記事で処理対象にした49種類のギリシャ文字のうち48種類のギリシャ文字を処理対象にしています。

対象となるギリシャ文字は上記の表に示したとおりです。

前回のマクロからの修正点は、87行目～90行目の記述です。

記号系（SymbolやWingdings）の文字を挿入する場合には、InsertSymbol メソッドを使います。このメソッドを使えば、記号系の文字として挿入されるので文字フォントで変更しようとしても文字化けしなくなります。

マクロ


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

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

　myChr(1) = "0391,65"
　myChr(2) = "0392,66"
　myChr(3) = "0393,71"
　myChr(4) = "0394,68"
　myChr(5) = "0395,69"
　myChr(6) = "0396,90"
　myChr(7) = "0397,72"
　myChr(8) = "0398,81"
　myChr(9) = "0399,73"
　myChr(10) = "039A,75"
　myChr(11) = "039B,76"
　myChr(12) = "039C,77"
　myChr(13) = "039D,78"
　myChr(14) = "039E,88"
　myChr(15) = "039F,79"
　myChr(16) = "03A0,80"
　myChr(17) = "03A1,82"
　myChr(18) = "03A3,83"
　myChr(19) = "03A4,84"
　myChr(20) = "03A5,85"
　myChr(21) = "03A6,70"
　myChr(22) = "03A7,67"
　myChr(23) = "03A8,89"
　myChr(24) = "03A9,87"
　myChr(25) = "03B1,97"
　myChr(26) = "03B2,98"
　myChr(27) = "03B3,103"
　myChr(28) = "03B4,100"
　myChr(29) = "03B5,101"
　myChr(30) = "03B6,122"
　myChr(31) = "03B7,104"
　myChr(32) = "03B8,113"
　myChr(33) = "03B9,105"
　myChr(34) = "03BA,107"
　myChr(35) = "03BB,108"
　myChr(36) = "03BC,109"
　myChr(37) = "03BD,110"
　myChr(38) = "03BE,120"
　myChr(39) = "03BF,111"
　myChr(40) = "03C0,112"
　myChr(41) = "03C1,114"
　myChr(42) = "03C3,115"
　myChr(43) = "03C4,116"
　myChr(44) = "03C5,117"
　myChr(45) = "03C6,102"
　myChr(46) = "03C7,99"
　myChr(47) = "03C8,121"
　myChr(48) = "03C9,119"

　'画面の更新をオフ
　Application.ScreenUpdating = False

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

　For i = 1 To 48

　　'「検索する文字列」と「置換後の文字列」の
　　'文字コードの読み込み
　　myText = Split(myChr(i), ",")

　　'文書の先頭から検索を開始
　　myRange.SetRange 0, 0

　　With myRange.Find
　　　.Text = ChrW("&h" & myText(0)) '"&"を"&h"に修正（2021/2/8）
　　　.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 '「明るい緑」の蛍光ペン
　　　　　.InsertSymbol Font:="Symbol", _
　　　　　　　　　　　　CharacterNumber:=myText(1), _
　　　　　　　　　　　　Unicode:=False
　　　　　.Collapse Direction:=wdCollapseEnd　'選択解除
　　　　End With
　　　　DoEvents
　　　Loop
　　End With

　Next i
　
　'Rangeオブジェクトの解放
　Set myRange = Nothing

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

End Sub