Office 2007/2010・リボンのカスタマイズ 初心者備忘録

カスタム検索
Office関連

文字列を強調表示する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