【コード】ギリシャ文字をシンボルフォントに変更するWordマクロ(その2)

以前、「【コード】ギリシャ文字をシンボルフォントに変更する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("&" & 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 '「明るい緑」の蛍光ペン
     .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

参考サイト

Selection.InsertSymbol Method (Word)

Finding and replacing symbols

アドインの対応する機能の修正

Wordで動く翻訳チェックソフト「色deチェック」:Ver. 3.3a以降は修正済み。

上書き翻訳用の一括置換ツール「ぱらぱら」:未対応(2017-08-19現在)

トップへ戻る