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フォントの対応に苦慮されている方の参考になれば幸いです。

関連記事

  1. Office関連

    [Office 2013]サインインを無効にする。(2)

    前回の記事では「SignInOptions」の値を変更してサインインを…

  2. Office関連

    未読メッセージ数を取得するOutlookマクロ

    Outlook 2007で追加されたFolderオブジェクトのUnRe…

  3. Windows 10

    【2017年1月版】Microsoft Edgeを操作するVBAマクロ(DOM編)(2)

    昨日の記事で、Microsoft Edgeを操作するVBAコードを改め…

  4. Office関連

    既存の機能の代わりにマクロを実行する方法をまとめてみました。

    「既存の機能の代わりにマクロを実行する」の関連になりますが、Offic…

  5. Office関連

    Excel 2016でマップグラフを作成する。

    12月6日、Office Insider向けに、Office 2016…

  6. Office関連

    PDFファイル上のフィールドの値を操作するVBAマクロ

    「PDFファイルに差し込み印刷するVBAマクロ」で、Acrobatを操…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP