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関連

    「2014年12月のWindows Update以降コマンドボタンが使えなくなった」トラブルへのFi…

    当ブログでも「KB2553154の更新プログラムをアンインストールする…

  2. Office関連

    Faviconをダウンロードするマクロ

    WebサイトからFaviconを抜き出すAPIがあったので早速使ってみ…

  3. Office関連

    【2018年9月版】Microsoft Office関連の公式リンクまとめ

    Ignite 2018やOffice 2019のリリースがあり、Off…

  4. アイコン一覧

    Office 2013 アイコン一覧(A)

    ・Office 2013 アイコン一覧 NUM…

  5. Office関連

    「カレンダーから日付入力」をUserFormに移植してみました。

    前回の記事では、Office 用アプリ「カレンダーから日付入力」と同様…

  6. Office関連

    新しくなったMZ-Tools

    みなさんは「MZ-Tools」というツールをご存知でしょうか?…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

Translate

Chinese (Simplified)Chinese (Traditional)EnglishFrenchGermanJapaneseKoreanRussianSpanish

最近の記事

アーカイブ

PAGE TOP