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

2017/09/23追記
この記事のマクロには間違いがあります。
修正版を「こうすればできる!!シンボルフォントを検索(4)」に掲載しました。

Symbolフォントに関するマクロです。

以前もこちらの記事「こうすればできる!!シンボルフォントの検索(3) 」にて紹介したことがあったのですが、処理を少しだけ早くしたバージョンです。

このマクロでできること

Symbolフォントのギリシャ文字(大文字・小文字)を検索して、黄色の蛍光ペンで着色します。

また、見つけたギリシャ文字の数を表示するようにしました。

マクロの解説

Symbolフォントを文字コードで検索し、見つけた場合に一括置換をしています。

探す文字コードは、水野麻子さんの「Word ギリシャ文字コード・ラテン文字対応表 」をご覧ください。

この表のSymbolフォントの10進数の値を用いています。

マクロ


Sub Symbol_Greece_Check()

  Dim i As Long '文字コード用
  Dim myRange As Range 'Rangeオブジェクト
  Dim myHighLight As String '蛍光ペンの設定の保存用
  Dim nCount As Integer '見つけたか文字種の数
  Dim myMessage As String 'メッセージ
    
  '蛍光ペンの設定
  myHighLight = Options.DefaultHighlightColorIndex
  Options.DefaultHighlightColorIndex = wdYellow
  
  'Rangeオブジェクトの設定
  Set myRange = ActiveDocument.Range(0, 0)
    
  'シンボルフォントのギリシャ文字を黄色の蛍光ペンで着色
  For i = 61505 To 61562
    If i >= 61531 And i <= 61536 Then GoTo Proc_Skip
    
    myRange.SetRange Start:=0, End:=0
        
    'ギリシャ文字を検索して黄色に着色
    With myRange.Find
      .Text = ChrW(i)
      .Replacement.Text = ""
      .Replacement.Highlight = True
      .Wrap = wdFindStop
      .Forward = True
      .Execute
      
      If .Found = True Then
        .Execute Replace:=wdReplaceAll
        nCount = nCount + 1
      End If
        
    End With
  
Proc_Skip:
  Next i
  
  If nCount > 0 Then
    myMessage = StrConv(nCount, vbWide) & "種類のSymbolフォントのギリシャ文字を着色しました。"
  Else
    myMessage = "Symbolフォントのギリシャ文字は見つかりませんでした。"
  End If
  
  MsgBox myMessage, vbInformation, "ギリシャ文字チェック"
  
  Options.DefaultHighlightColorIndex = myHighLight
  Set myRange = Nothing

End Sub

関連記事

Word ギリシャ文字コード・ラテン文字対応表  (水野麻子さんの記事)

トップへ戻る