【コード】キーワードを一重下線でマーキングするWordマクロ

最近、蛍光ペンのマーキングのマクロを2つ紹介しました。

【コード】キーワードを蛍光ペンで着色するWordマクロ

【コード】キーワードを蛍光ペンで着色するWordマクロ(その2)

これを応用して、一重下線でマーキングをするマクロを紹介します。

このマクロでできること

インプットボックスでキーワードを指定します。

[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

関連記事

【コード】キーワードを蛍光ペンで着色するWordマクロ

【コード】キーワードを蛍光ペンで着色するWordマクロ(その2)

トップへ戻る