文字列を強調表示するWordテンプレート(Word 2003)

「文字列をハイライト表示するWordテンプレート」でWord 2007以降に対応した、クイックアクセスツールバーから文字列をハイライト表示するテンプレートを公開していますが、似たような処理ができるWord 2003用のテンプレートも作成しました。

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

文字列を強調表示するWordテンプレート

このテンプレート(HitHighlight2003.dot)ファイルをWordのスタートアップフォルダにコピーして(スタートアップフォルダを開く際は「Wordのスタートアップフォルダを開く(VBS)」で紹介しているスクリプトが便利です)Wordを起動すると、標準ツールバーに文字列を入力するテキストボックスが表示されます(テンプレートが不要になった場合はスタートアップフォルダからHitHighlight2003.dotファイルを削除してください)。

このテキストボックスに強調表示したい文字列を入力しEnterキーを押すと、文章内にある入力した文字列が強調表示されます(仕様上一瞬だけ検索と置換ダイアログが表示されます)。

Ctrl + Shift + F キーを押すとテキストボックスにフォーカスが移り、その状態でEnter キーを押すと、文字列を入力することができるようになります。

※ 強調表示をしても文字色と文字の背景色が変更されるわけではありません。

Sponsored Links

このテンプレートで使用しているコードは下記の通りです。

[標準モジュール]


                        Option Explicit

                        

                        Private Declare Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hWnd As Long, ByVal dwId As Long, riid As Any, ByRef ppvObject As Office.IAccessible) As Long

                        Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

                        Private Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, lpiid As Any) As Long

                        

                        Private Const CHILDID_SELF = 0&

                        Private Const OBJID_CLIENT = &HFFFFFFFC

                        Private Const NAVDIR_FIRSTCHILD = &H7

                        Private Const ROLE_SYSTEM_CHECKBUTTON = &H2C

                        

                        Private Sub MenuProc()

                          FindAndHighLight Application.CommandBars.ActionControl.Text

                        End Sub

                        

                        Private Sub FindAndHighLight(ByVal SearchPhrase As String)

                        '検索処理

                          If CInt(Val(Application.Version)) <> 11 Then

                            MsgBox "当テンプレートはWord 2003専用です。" & vbCrLf & "処理を中止します。", vbCritical + vbSystemModal

                            Exit Sub

                          End If

                          If Len(Trim$(SearchPhrase)) < 1 Then Exit Sub

                          Selection.Collapse '選択解除

                          '検索設定(各項目は適当に設定)

                          With Selection.Find

                            .ClearFormatting

                            .Text = SearchPhrase

                            .Replacement.Text = ""

                            .Forward = True

                            .Wrap = wdFindContinue

                            .Format = False

                            .MatchCase = False

                            .MatchWholeWord = False

                            .MatchByte = False

                            .MatchAllWordForms = False

                            .MatchSoundsLike = False

                            .MatchWildcards = False

                            .MatchFuzzy = False

                          End With

                          ExecuteHighLight

                        End Sub

                        

                        Private Sub ExecuteHighLight()

                        'ハイライト処理実行

                          Dim acc As Office.IAccessible

                          Dim accTab As Office.IAccessible

                          Dim h As Long

                          Dim IID(0 To 3) As Long

                          

                          Const NumChk = &HC&

                          Const NumBtnFind = &H10&

                          Const NumBtnClose = &H13&

                          

                          Application.CommandBars.FindControl(ID:=141).Execute 'ダイアログ表示

                          h = FindWindow("bosa_sdm_Microsoft Office Word 11.0", "検索と置換")

                          If h = 0& Then GoTo Err

                          IIDFromString StrPtr("{618736E0-3C3D-11CF-810C-00AA00389B71}"), IID(0)

                          If AccessibleObjectFromWindow(h, OBJID_CLIENT, IID(0), acc) <> 0& Then GoTo Err

                          Set accTab = acc.accNavigate(NAVDIR_FIRSTCHILD, CHILDID_SELF)

                          If accTab Is Nothing Then GoTo Err

                          accTab.accDoDefaultAction 1& '"検索"タブクリック

                          '"見つかったすべての項目を強調表示する"にチェック

                          If acc.accRole(NumChk) <> ROLE_SYSTEM_CHECKBUTTON Then GoTo Err

                          If Trim$(acc.accDefaultAction(NumChk)) = "選択する" Then acc.accDoDefaultAction NumChk

                          '"すべて検索"ボタンクリック

                          If InStr(acc.accName(NumBtnFind), "すべて検索") = False Then GoTo Err

                          acc.accDoDefaultAction NumBtnFind

                          '"閉じる"ボタンクリック

                          If InStr(acc.accName(NumBtnClose), "閉じる") = False Then GoTo Err

                          acc.accDoDefaultAction NumBtnClose

                          Exit Sub

                        Err:

                          MsgBox "処理が失敗しました。", vbCritical + vbSystemModal

                        End Sub

                        

                        Public Sub SetFocusEditControl()

                        '※ コントロールフォーカス用(当プロシージャ実行後にEnterキーで入力可能)

                        '※ Ctrl + Shift + F キーに割り当て

                          Dim c As Office.CommandBarControl

                          

                          On Error Resume Next

                          For Each c In Application.CommandBars("Standard").Controls

                            If InStr(c.Caption, "文字列") Then

                              If InStr(c.Caption, "強調表示") Then

                                c.SetFocus

                                Exit For

                              End If

                            End If

                          Next

                          On Error GoTo 0

                        End Sub