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

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

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

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

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

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

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

このマクロでできること

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

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

(実行前)

(実行後)

マクロの解説

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などで示しています。

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

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

こうすればできる!!シンボルフォントの検索(2)

こうすればできる!!シンボルフォントの検索(3)

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

トップへ戻る