追記 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







