カスタム検索
リボン関連

文字列をハイライト表示するWordテンプレート(3)

文字列をハイライト表示するWordテンプレート(2)」でWord 2007以降に対応した、クイックアクセスツールバーから文字列をハイライト表示するテンプレートを公開していますが、このテンプレートでハイライト表示した文字列は文書を閉じるとハイライトがクリアされてしまいます。
今度は文書を閉じてもハイライトがクリアされない(= 文書に変更を加える)テンプレートを作成したので下記にて紹介します。

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

文字列をハイライト表示するWordテンプレート(3)

 

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

このテキストボックスにハイライト表示したい文字列を入力しEnterキーを押すと、文章内にある入力した文字列がハイライト表示されます。
スペース(半角・全角問わず)で区切った複数の文字列を色分けしてハイライト表示します(現状では10種類の配色に対応していますが、コードを変更することで色の組み合わせや色数を変更することが可能です)。

文字列ハイライトクリア」ボタンをクリックすると、ハイライト表示がクリアされます。
※ クイックアクセスツールバーのショートカットキー(ALTキー + 数字キー)で操作をすると、効率良くハイライト表示できます。

 

Sponsored Links

 

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

[標準モジュール]

Option Explicit

Private Const BMPrefix As String = "KANETMACRO_" 'ブックマーク判別用文字列

Public Sub edtHitHighlight_onChange(control As IRibbonControl, text As String)
  Dim HCol(9) As Variant
  Dim TCol(9) As Variant
  Dim s As String
  Dim v As Variant
  Dim i As Long, j As Long
  
  If Len(Trim$(text)) < 1 Then Exit Sub
  
  '-----------------------------------------
  '※ 文字色と背景色
  '※ 好みに応じて(色数含めて)自由に設定
  '-----------------------------------------
  'HighlightColor
  HCol(0) = &HFF3300
  HCol(1) = &H33FF
  HCol(2) = &H6000
  HCol(3) = &H3399FF
  HCol(4) = &HFFFFCC
  HCol(5) = &H666633
  HCol(6) = &H33FFFF
  HCol(7) = &HFF3399
  HCol(8) = &H66FFCC
  HCol(9) = &H6600CC
  
  'TextColor
  TCol(0) = &HFFFFFF
  TCol(1) = &HFFFFFF
  TCol(2) = &HFFFFFF
  TCol(3) = &HFFFFFF
  TCol(4) = &H660000
  TCol(5) = &H33FFFF
  TCol(6) = &H3300
  TCol(7) = &HFFFFFF
  TCol(8) = &H330033
  TCol(9) = &H66FFFF
  '-----------------------------------------
  
  s = Replace(text, " ", " ") '全角スペースを半角スペースに置換
  '連続スペースを1スペースに置換
  With CreateObject("VBScript.RegExp")
    .Pattern = " +"
    .IgnoreCase = True
    .Global = True
    If .Test(s) Then s = .Replace(s, " ")
  End With
  
  ExecuteClearHitHighlight
  
  v = Split(s, " ")
  j = LBound(v) '初期化
  For i = LBound(v) To UBound(v)
    If j > 9 Then j = LBound(v) '色数を超えたら初期化
    ExecuteHitHighlight v(i), HCol(j), TCol(j)
    j = j + 1
  Next
End Sub

Public Sub btnClearHitHighlight_onAction(control As IRibbonControl)
  ExecuteClearHitHighlight
End Sub

Private Sub ExecuteHitHighlight(ByVal SearchPhrase As String, Optional ByVal HighlightColor As Variant = wdColorYellow, Optional ByVal TextColor As Variant = wdColorRed)
'ハイライト処理実行
  Dim r As Word.Range
  Dim i As Long
  
  i = 1 '初期化
  Set r = ActiveDocument.Range(0, 0)
  With r.Find
  '検索条件は適宜変更
    .ClearFormatting
    .ClearAllFuzzyOptions
    .text = SearchPhrase
    .Replacement.text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = True
    .MatchWholeWord = True
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = False
    .MatchFuzzy = False
    Do While .Execute
      With r.Font
        .Shading.BackgroundPatternColor = HighlightColor
        .Color = TextColor
      End With
      'クリア処理するためにブックマーク追加
      ActiveDocument.Bookmarks.Add BMPrefix & SearchPhrase & i, r
      i = i + 1
    Loop
  End With
  Set r = Nothing
End Sub

Private Sub ExecuteClearHitHighlight()
'ハイライトクリア
  Dim b As Word.Bookmark
  
  For Each b In ActiveDocument.Bookmarks
    If Left$(b.Name, Len(BMPrefix)) = BMPrefix Then
      With b.Range.Font
        .Shading.BackgroundPatternColor = wdColorAutomatic
        .Color = wdColorAutomatic
      End With
      b.Delete
    End If
  Next
End Sub
[リボンXML]
<?xml version="1.0" encoding="utf-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
  <ribbon>
    <tabs>
      <tab id="tabHitHighlight" label="HitHighlight" visible="false">
        <group id="grpHitHighlight" label="HitHighlight">
          <editBox id="edtHitHighlight" sizeString="wwwwwwwwww" onChange="edtHitHighlight_onChange" screentip="文字列ハイライト表示" supertip="ここに入力した文字列をハイライト表示します。&#xD;&#xA;※ 文書に変更を加えます。" />
          <button id="btnClearHitHighlight" label="ClearHitHighlight" size="normal" imageMso="Clear" onAction="btnClearHitHighlight_onAction" screentip="文字列ハイライトクリア" supertip="文字列のハイライト表示をクリアします。" />
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>