文字列をハイライト表示する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>