Office関連

徹底的にSymbol(シンボル)フォントをチェックするWordマクロ

文字列をメモ帳にコピー&ペーストすると文字化けしたり、フォント指定で検索しているのに何故かヒットしなかったり、Wordマクロを書く人間にとって何かと厄介なのが“Symbol(シンボル)フォント”です。

ライターや翻訳者など、大量の文字をWordで扱ったことがある人ならば、一度は引っ掛かったことがあるのではないでしょうか?

Word MVPの新田さんのブログにも、このSymbolフォントを扱っている記事が数多くあります。

私も数年前にHPで「指定したフォントが使われているかどうかをチェックする」というWordマクロのコードを書いたのですが、以前書いたコードは非効率的な部分もあるので、今回改めてコードを見直すことにしました。

Option Explicit

Public Sub Sample()
'"Symbol"フォントかどうかを一文字ずつチェック
  Dim tmp As Word.Range
  Dim r As Word.Range
  
  Set tmp = Selection.Range
  Application.ScreenUpdating = False
  For Each r In ActiveDocument.Characters
    If ChkSymbolFont(r) = True Then
      '"Symbol"フォントだったら蛍光ペンでマーク
      r.HighlightColorIndex = wdPink
    End If
  Next
  Application.ScreenUpdating = True
  tmp.Select
  MsgBox "処理が終了しました。", vbInformation + vbSystemModal
End Sub

Private Function ChkSymbolFont(ByVal TargetCharacter As Word.Range) As Boolean
'指定したRange(1文字)のフォントが「Symbol」かどうかをチェック
  Dim FontName As String: FontName = LCase("Symbol")
  Dim ret As Boolean
  
  '文字数チェック
  If TargetCharacter.Characters.Count > 1 Then _
     Err.Raise Number:=513, Description:="引数の文字数を「1」にしてください。"
  
  '初期化
  ret = False
  TargetCharacter.Select
  
  'Fontオブジェクトのプロパティチェック
  With Selection
    If LCase(.Font.Name) = FontName Then ret = True: GoTo EndProc
    If LCase(.Font.NameAscii) = FontName Then ret = True: GoTo EndProc
    If LCase(.Font.NameBi) = FontName Then ret = True: GoTo EndProc
    If LCase(.Font.NameFarEast) = FontName Then ret = True: GoTo EndProc
    If LCase(.Font.NameOther) = FontName Then ret = True: GoTo EndProc
  End With

  'フォントダイアログチェック
  With Application.Dialogs(wdDialogFormatFont)
    If LCase(.Font) = FontName Then ret = True: GoTo EndProc
    If LCase(.FontHighAnsi) = FontName Then ret = True: GoTo EndProc
    If LCase(.FontLowAnsi) = FontName Then ret = True: GoTo EndProc
    If LCase(.FontNameBi) = FontName Then ret = True: GoTo EndProc
  End With

  '記号と特殊文字ダイアログチェック
  With Application.Dialogs(wdDialogInsertSymbol)
    If LCase(.Font) = FontName Then ret = True: GoTo EndProc
  End With
  
EndProc:
  ChkSymbolFont = ret
End Function

やっていることは以前書いたコードと同じで、一文字ずつチェック用の関数に渡して、文書中のどこにSymbolフォントがあるのかをチェックする、というものです。

Fontオブジェクトからフォント名関連の各プロパティをチェック、フォントダイアログから取得できる各フォント名をチェック、記号と特殊文字ダイアログから取得できるフォント名をチェック、これだけやればさすがに漏れなくチェックできるのではないかと思います。

ホントは下記コードのようにRangeやSelectionか取得できるXMLから判別する方法も考えたのですが、効率が悪そうなので止めにしました。

Dim node As Object
Dim attr As Object

With CreateObject("MSXML2.DOMDocument")
  If .LoadXML(Selection.XML) = True Then
    Set node = .SelectSingleNode("/w:wordDocument/w:body/wx:sect/w:p/w:r/w:sym")
    If Not node Is Nothing Then
      Set attr = node.Attributes.getNamedItem("w:font")
      If Not attr Is Nothing Then
        If LCase(attr.NodeValue) = LCase("Symbol") Then MsgBox "Symbolフォントです。"
      End If
    End If
  End If
End With

一文字ずつのチェックになるため、動作速度としては速いものではありませんが、Symbolフォントの対応に苦慮されている方の参考になれば幸いです。

段落内改行を一括置換するOutlookマクロ前のページ

PowerPointスライドショー終了後ファイルを閉じるVBAマクロ次のページ

関連記事

  1. Office関連

    カウントダウンタイマーを作成するPowerPointマクロ

    大分前に書いた記事について問い合わせがありましたので、マクロを作成しな…

  2. アイコン一覧

    Office 365アイコン(imageMso)一覧(D)

    Office 365のデスクトップ版Officeアプリケーション(Wo…

  3. Office関連

    蛍光ペンでマークした部分の文字数をカウントするWordマクロ

    Twitterでたまたま下記のツイートを見つけたので、簡単な処理を考え…

  4. Office関連

    関数一覧(Excel 2013 Customer Preview)

    関数の挿入ダイアログから抽出したExcel 2013 Customer…

  5. Office関連

    コマンドマクロ一覧(Word 2013 Customer Preview)

    Word 2013 CP版に組み込まれている「コマンドマクロ」のコマン…

  6. Excel

    Evernote Cloud SDKを使って特定の文字列が含まれるノートを検索するVBAマクロ

    前回の記事で、VBAからEvernote Cloud SDKを使ってノ…

コメント

  • コメント (0)

  • トラックバックは利用できません。

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

Translate

Chinese (Simplified)Chinese (Traditional)EnglishFrenchGermanJapaneseKoreanRussianSpanish

最近の記事

アーカイブ

PAGE TOP