追記 2013年8月20日 以下の記事に改良版を掲載しました。 【コード】キーワードを蛍光ペンで着色するWordマクロ(その2)
指定したキーワードを蛍光ペンで着色するマクロです。
セミナーを受講いただいた方からご質問をいただきました。
ブログ内でシンプルなマクロを探したのですが、すぐに見つからなかったのでつくりました。
ありそうな気がしたんですが。。。
セミナーではオブジェクト変数の説明はしておりませんが、おおよそ意味は理解できると思います。
<目次>
このマクロでできること
マクロを実行するとインプットボックスが表示されます。
ここで入力したキーワードを蛍光ペンの黄色で着色します。
検索オプションはすべてオフとしています。)
マクロの解説
(1)蛍光ペンの色の設定
Options.DefaultHighlightColorIndexにて、置換後の文字列の蛍光ペンの色を設定します(16行目)。
「検索と置換」ダイアログボックスには、[検索する文字列] に対しても、[置換後の文字列 に対しても、蛍光ペンの色を指定する項目がありません。
蛍光ペンを使うかどうか(オンかオフか)だけを、[検索する文字列] と [置換後の文字列] のそれぞれに設定します。
今回は、置換後の文字列に蛍光ペンで着色するので、以下のようにしています(25行目)。
.Replacement.Highlight = True '置換語の文字列の蛍光ペンをオン
では、色はどこで設定するのでしょうか。それは、Wordのフォントの書式設定で指定します。
ただ、[検索する文字列] の蛍光ペンの色は指定できません。
[置換後の文字列] の蛍光ペンの色は指定できます。「検索と置換」ダイアログボックスの [置換後の文字列] の蛍光ペンがオンになった場合には、現在Wordで設定されている蛍光ペンの色が [置換後の文字列] に採用されるというわけです。
現在Wordで設定されている蛍光ペンの色というのが、Options.DefaultHighlightColorIndex の値に対応します。
(2)検索条件の設定
29行目~35行目で、検索オプションの設定をします。
チェックマークを入れる場合には、Trueにします。
現在は、すべてオフにしているので、Falseとなっています。
(3)[置換後の文字列] の設定
「検索と置換」ダイアログボックスでは、置換後の文字列の書式を変更する場合には、[置換後の文字列]欄が空欄でも置換ができます。
この場合、[検索する文字列] 欄の文字列がそのまま置換後の文字列として使われます。
以下のマクロでは、24行目と28行目でこの設定をします。
置換後の文字列は空欄。書式をオンにします。
マクロ
Sub キーワードを蛍光ペンで着色() Dim myRange As Range Dim myKW As String Dim myColor As String myKW = InputBox("キーワードを入力してください。") 'キーワードが入力されない場合には終了 If myKW = "" Then Exit Sub '現在の蛍光ペンの色を保存 myColor = Options.DefaultHighlightColorIndex '蛍光ペンの色を黄色に設定 Options.DefaultHighlightColorIndex = wdYellow 'myRange(オブジェクト変数)を設定 Set myRange = ActiveDocument.Range(0, 0) '一括置換を実行(「検索と置換」ダイアログボックスの設定) With myRange.Find .Text = myKW '検索する文字列 .Replacement.Text = "" '置換後の文字列(空欄でOK) .Replacement.Highlight = True '置換後の文字列の蛍光ペンをオン .Forward = True .Wrap = wdFindStop .Format = True '書式の設定をオン .MatchCase = False '大文字と小文字の区別する .MatchWholeWord = False '完全に一致する単語だけを検索する .MatchByte = False '半角と全角を区別する .MatchAllWordForms = False '英単語の異なる活用形を検索する .MatchSoundsLike = False 'あいまい検索(英) .MatchFuzzy = False 'あいまい検索(日) .MatchWildcards = False 'ワイルドカードを使用する .Execute Replace:=wdReplaceAll End With '蛍光ペンの色を元に戻す Options.DefaultHighlightColorIndex = myColor 'myRangeを解放 Set myRange = Nothing End Sub