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

2011年11月8日

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

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

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

このマクロでできること

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 ギリシャ文字コード・ラテン文字対応表 　（水野麻子さんの記事）

-コード
-, ,