最近、蛍光ペンのマーキングのマクロを2つ紹介しました。
【コード】キーワードを蛍光ペンで着色するWordマクロ（その２）
これを応用して、一重下線でマーキングをするマクロを紹介します。
＜目次＞
このマクロでできること
インプットボックスでキーワードを指定します。
[OK] ボタンをクリックすると、本文中のキーワードが一重下線でマーキングされます。キーワードの検索条件は、「半角と全角を区別する」です。
マクロの解説
前回の蛍光ペンのマクロでは、蛍光ペンの色の指定がポイントでした。
「検索と置換」ダイアログボックスでは蛍光ペンの色を指定できないため、別の方法が必要でしたね。
今回の一重下線の指定は、「検索と置換」ダイアログボックスでできます。
なので、かなりシンプルです。
25行目で、[置換後の文字列] の書式を指定します。
フォントのプロパティで下線を一重下線にしています。
.Replacement.Font.Underline = wdUnderlineSingle '一重下線
28行目で、置換操作で書式を使うのかどうかを設定します。
フォントの書式を変更するので、オンにします。
.Format = True '書式の設定をオン
マクロ
Sub キーワードを一重下線()
Dim myRange As Range
Dim myDefault As String 'インプットボックスのデフォルトの文字列
Dim myKW As String '着色するキーワード
'キーワードが選択されていない場合
If Selection.Type = wdSelectionIP Then
myDefault = ""
Else
'キーワードが選択されている場合
myDefault = Trim(Selection.Text)
End If
myKW = InputBox("文字列を入力してください。" & vbCr & _
"検索条件:半角と全角を区別する", "一括一重下線", myDefault)
'myRange（オブジェクト変数）を設定
Set myRange = ActiveDocument.Range(0, 0)
'一括置換を実行（「検索と置換」ダイアログボックスの設定）
With myRange.Find
.Text = myKW '検索する文字列
.Replacement.Text = "" '置換後の文字列（空欄でOK）
.Replacement.Font.Underline = wdUnderlineSingle '一重下線
.Forward = True
.Wrap = wdFindStop
.Format = True '書式の設定をオン
.MatchCase = False '大文字と小文字の区別する
.MatchWholeWord = False '完全に一致する単語だけを検索する
.MatchAllWordForms = False '英単語の異なる活用形を検索する
.MatchSoundsLike = False 'あいまい検索（英）
.MatchFuzzy = False 'あいまい検索（日）
.MatchWildcards = False 'ワイルドカードを使用する
.MatchByte = True '半角と全角を区別する
.Execute Replace:=wdReplaceAll
End With
'myRangeを解放
Set myRange = Nothing
End Sub