【Word VBA】こうすればできる!!シンボルフォントを検索するWordマクロ(4)

こうすればできる!!シンボルフォントの検索こうすればできる!!シンボルフォントの検索(2)こうすればできる!!シンボルフォントの検索(3)こうすればできる!!シンボルフォントを検索(4) ←現在地

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

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

Symbolフォントの検索はできているのですが、それが果たして本当にSymbolフォントであるかについての検証がされていません。たとえば、「こうすればできる!!シンボルフォントの検索(3)」のマクロでは、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

関連記事

トップへ戻る