【Word VBA】こうすればできる！！シンボルフォントを検索するWordマクロ（４）

2017年9月23日

, , 
・こうすればできる！！シンボルフォントの検索
・こうすればできる！！シンボルフォントの検索（２）
・こうすればできる！！シンボルフォントの検索（３）
・こうすればできる！！シンボルフォントを検索（４） ←現在地

以前の記事を読み返して修正が必要だと思ったので書き直しました。

上記の記事で、Symbolフォントのギリシャ文字をピンクの蛍光ペンで着色しています。

Symbolフォントの検索はできているのですが、それが果たして本当にSymbolフォントであるかについての検証がされていません。たとえば、「こうすればできる！！シンボルフォントの検索（３）」のマクロでは、Wingdings 2 フォントの記号が着色されてしまいます。

同じ文字コードで別のフォントが使われているからです。

よって、今回の記事では、文字コードで見つけた文字列のフォント名がSymbolフォントの場合にだけピンクの蛍光ペンで着色します。

このマクロでできること

現在カーソルが置かれている文書中の本文に書かれたSymbolフォントのギリシャ文字を着色します。ヘッダーやフッター、テキストボックスに書かれたものは着色しません。

実行前

実行後

マクロの解説

気付いていなかったのですが同じようなマクロを書いていたので、こちらの記事「【コード】Symbolフォントのギリシャ文字を蛍光ペンで着色するWordマクロ 」を流用しました。

38行目～45行目のとおり、検索条件を明示するように修正しました。

50行目にて、検索した文字列がSymbolフォントであるかを判定しています。

このDialogs(wdDialogInsertSymbol) は組み込みの［記号と特殊文字］ダイアログボックスを示しています。

このダイアログボックスでフォント名を判定しています。このダイアログボックスを用いる場合には、対象文字列を選択しておく必要がありますので、RangeオブジェクトをSelectionオブジェクトに変更する必要があります。

この処理を49行目で行っています。RangeオブジェクトをSelectメソッドで選択します。

マクロ


Sub Symbol_Greece_Check2()

　Dim myDoc As Document
　Dim myRange As Range 'Rangeオブジェクト
　Dim i As Long '文字コード用
　Dim blnFound As Boolean '見つけた場合にTrue
　Dim nCount As Integer '見つけた文字種の数
　Dim myMessage As String 'メッセージ
　
　'-------------------------------------------
　'前処理
　'-------------------------------------------
　'Documentオブジェクトの設定
　Set myDoc = ActiveDocument
　
　nCount = 0
　
　'-------------------------------------------
　'Symbolフォントのギリシャ文字を検索
　'-------------------------------------------
　For i = 61505 To 61562
　
　　If i >= 61531 And i <= 61536 Then
　　　'何もしない
　　Else
　　
　　　'Rangeオブジェクトの設定
　　　Set myRange = myDoc.Range(0, 0)
　
　　　'検索の判定をリセット
　　　blnFound = False
　　　
　　　'ギリシャ文字を検索
　　　With myRange.Find
　　　　.Text = ChrW(i)
　　　　.Wrap = wdFindStop
　　　　.Format = False
　　　　.MatchWholeWord = False　　 '完全に一致する単語だけを検索する
　　　　.MatchAllWordForms = False　'英単語の異なる活用形を検索する
　　　　.MatchSoundsLike = False　　'あいまい検索（英）
　　　　.MatchFuzzy = False　　　　 'あいまい検索（日）
　　　　.MatchByte = False　　　　　'半角と全角を区別する
　　　　.MatchCase = False　　　　　'大文字と小文字の区別する
　　　　.MatchWildcards = False　　 'ワイルドカードを使用する
　　　　
　　　　Do While .Execute = True
　　　　　With myRange
　　　　　　'Symbolフォントであることの確認
　　　　　　.Select
　　　　　　If Dialogs(wdDialogInsertSymbol).Font = "Symbol" Then
　　　　　　　blnFound = True
　　　　　　　myRange.HighlightColorIndex = wdPink
　　　　　　End If
　　　　　　.Collapse wdCollapseEnd
　　　　　End With
　　　　Loop
　　　　
　　　　If blnFound = True Then
　　　　　nCount = nCount + 1
　　　　End If
　　　　
　　　　DoEvents
　　　　
　　　End With
　　
　　End If

　Next i
　
　If nCount <> 0 Then
　　myMessage = nCount & "種類のSymbolフォントのギリシャ文字を着色しました。"
　Else
　　myMessage = "Symbolフォントのギリシャ文字は見つかりませんでした。"
　End If
　
　MsgBox myMessage, vbInformation, "ギリシャ文字チェック"
　
　Set myRange = Nothing

End Sub

関連記事

-コード
-, ,