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マクロ

    PowerPointにはオリジナルのレイアウト(ユーザー設定レイアウト…

  2. Office関連

    Re: 【Wordマクロ】Word起動時に、前回終了時に開いていたファイルを表示

    Word MVPの新田さんがブログで面白い記事を書かれていました。…

  3. Office関連

    [VBA]CommandBars(“○○”).Controls.Addでメニ…

    Officeのユーザインタフェースがリボンに変わってから、下記のように…

  4. Office関連

    Google TTSで文字列を読み上げるExcelアドイン

    前回の記事で書いたGoogle TTSで文字列を読み上げるマクロ(言語…

  5. Office関連

    「クラシックスタイルメニュー」の誤検知?

    2013/07/16 追記:cx20さんにコメントで"Google…

  6. Office関連

    [Office]アイコンの検索機能が超便利!

    ※ 下記情報はInsider版のOfficeを元にしています。バージョ…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

PAGE TOP