カスタム検索
リボン関連

プルダウンからフォントを検索するWordテンプレート(リボン対応版)

プルダウンからフォントを検索するWordテンプレート」で、プルダウンからフォントを指定してそのフォントがどこで使われているかをチェックするテンプレートを公開していますが、2007以降のリボンにも対応したテンプレートも作成しました。

※ このテンプレートはマクロを使用していますが、全文書対象のテンプレート(Normal.dot、Normal.dotm)ファイルには変更を加えません。

プルダウンからフォントを検索するWordテンプレート(リボン対応版)

 

このテンプレート(CheckFont.dotm)ファイルをWordのスタートアップフォルダにコピーして(スタートアップフォルダを開く際は「Wordのスタートアップフォルダを開く(VBS)」で紹介しているスクリプトが便利です)Wordを起動すると、クイックアクセスツールバーにフォントを選択するプルダウンとハイライト(蛍光ペン)クリア用のボタンが表示されます(テンプレートが不要になった場合はスタートアップフォルダからCheckFont.dotmファイルを削除してください)。

プルダウンからフォントを選択すると実行確認ダイアログが表示されるので、「はい」ボタンをクリックします。


厳密なチェック確認ダイアログが表示されるので、厳密にフォントをチェックする場合(Symbolフォントのチェック等)は「はい」ボタンをクリックし、そうでない場合は「いいえ」ボタンをクリックしてください(「はい」ボタンをクリックすると、日本語用のフォントや英数字用のフォント等、各フォント設定項目のいずれかにフォントが設定されていたらチェック処理を行います)。



ハイライト(蛍光ペン)クリアボタンをクリックすると、文書に設定されたハイライト(蛍光ペン)をクリアします。

 

Sponsored Links

 

このテンプレートで使用しているコードは下記の通りで、クイックアクセスツールバーへの登録は「クイックアクセスツールバーのボタンイメージを好きな画像にする(2)」で紹介した方法で行っています。
※ リボンXMLの編集方法については「Office Ribbon Editorの紹介」「SharpDevelopでリボンXMLを編集する」等のページを参照してください。

[標準モジュール]

Option Explicit

Private FNames() As String

Private Sub RibbonChkFont_onLoad(ribbon As IRibbonUI)
  Dim cnt As Long, i As Long

  cnt = Application.FontNames.Count
  ReDim FNames(cnt)
  For i = 0 To cnt - 1
    FNames(i) = Application.FontNames(i + 1)
  Next
End Sub

Private Sub CboChkFont_getItemCount(control As IRibbonControl, ByRef returnedVal)
  returnedVal = Application.FontNames.Count
End Sub

Private Sub CboChkFont_getItemLabel(control As IRibbonControl, index As Integer, ByRef returnedVal)
  returnedVal = FNames(index)
End Sub

Private Sub CboChkFont_onChange(control As IRibbonControl, text As String)
  Dim r As Word.Range
  Dim mode As Long
  
  If Len(Trim$(text)) < 1 Then Exit Sub
  If MsgBox("フォントチェックを実行しますか?" & vbCrLf & vbCrLf & _
            "※ 1文字ずつチェックするため、ボリュームの多い文書では時間が掛かる場合があります。" & vbCrLf & _
            "※ チェックを実行すると現在設定されている「蛍光ペン」が無効化されます。", vbYesNo + vbSystemModal + vbInformation) = vbNo Then Exit Sub
  If MsgBox("厳密なチェックを行いますか?" & vbCrLf & vbCrLf & _
            "※ 厳密なチェックを行うと日本語用のフォントや英数字用のフォント等、各フォント設定項目のいずれかにフォントが設定されていたらハイライト処理を行います。" & vbCrLf & _
            "※ Symbolフォントのチェック等に向いています。", _
            vbYesNo + vbSystemModal + vbInformation) = vbYes Then
    mode = 1
  Else
    mode = 2
  End If
  Application.ScreenUpdating = False
  ClearHighlight 'ハイライトクリア
  For Each r In ActiveDocument.Characters
    If ChkFont(r, text, mode) Then
      r.HighlightColorIndex = wdYellow
    End If
  Next
  Selection.HomeKey unit:=wdStory
  Application.ScreenUpdating = True
  MsgBox "処理が終了しました。", vbInformation + vbSystemModal
End Sub

Private Sub BtnClearHighlight_onAction(control As IRibbonControl)
  ClearHighlight
End Sub

Private Function ChkFont(ByVal rTarget As Word.Range, ByVal sFontName As String, Optional ByVal mode As Long = 1) As Boolean
  Dim ret As Boolean
  Dim dlg As Word.Dialog
  
  ret = False '初期化
  rTarget.Select
  Set dlg = Application.Dialogs(wdDialogFormatFont)
  Select Case mode
    Case 1
      If Selection.Font.Name = sFontName Then
        ret = True
      ElseIf Selection.Font.NameAscii = sFontName Then
        ret = True
      ElseIf Selection.Font.NameBi = sFontName Then
        ret = True
      ElseIf Selection.Font.NameFarEast = sFontName Then
        ret = True
      ElseIf Selection.Font.NameOther = sFontName Then
        ret = True
      ElseIf dlg.Font = sFontName Then
        ret = True
      ElseIf dlg.FontHighAnsi = sFontName Then
        ret = True
      ElseIf dlg.FontLowAnsi = sFontName Then
        ret = True
      ElseIf dlg.FontNameBi = sFontName Then
        ret = True
      ElseIf Application.Dialogs(wdDialogInsertSymbol).Font = sFontName Then
        ret = True
      End If
    Case 2
      If Selection.Font.Name = sFontName Then
        ret = True
      End If
  End Select
  Set dlg = Nothing
  ChkFont = ret
End Function

Private Sub ClearHighlight()
  ActiveDocument.Content.HighlightColorIndex = wdNoHighlight
End Sub
[リボンXML]
<?xml version="1.0" encoding="utf-8"?>
<customUI onLoad="RibbonChkFont_onLoad" xmlns="http://schemas.microsoft.com/office/2006/01/customui">
  <ribbon>
    <tabs>
      <tab id="tabChkFont" label="CheckFont Tab" visible="false">
        <group id="grpChkFont" label="CheckFont Group">
          <comboBox id="cboChkFont" sizeString="WWWWWWWWWW" getItemCount="CboChkFont_getItemCount" getItemLabel="CboChkFont_getItemLabel" onChange="CboChkFont_onChange" supertip="選択したフォントがどこで使われているかを検索して、蛍光ペンでマークします。" screentip="プルダウンからフォント検索" />
          <button id="btnClearHighlight" label="ClearHighlight" imageMso="Clear" onAction="BtnClearHighlight_onAction" supertip="ハイライト(蛍光ペン)をクリアします。" screentip="プルダウンからフォント検索" />
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>