プルダウンからフォントを検索する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>