キーワードをカッコで括るマクロ(Word)

キーワードをカッコで括るマクロ

Wordドキュメントの中に出てくるキーワードをカッコで括るマクロ。

キーワードの部分を取得する

まずは、キーワードの部分を取得しなければならない。Rangeオブジェクトとして取得すれば、あとは[Range].Textプロパティを書き換えればオッケー。

リスト1
'キーワードを検索し、ヒットした箇所のRangeオブジェクトを返すメソッド'
Private Function getNextRange( _
          ByVal tgtText As String) As Range
  Dim ret As Range
  Set ret = Nothing
  With Selection.Find
    .Text = tgtText
    .Replacement.Text = ""
    .Wrap = wdFindStop
    .Format = False
    .Highlight = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = False
    .MatchFuzzy = False
  End With
  Call Selection.Find.Execute
  If Not Selection.Find.Found Then Exit Function
  Set ret = Selection.Range
  Set getNextRange = ret
End Function

おなじみFindオブジェクトを用いてキーワードを検索する。Find.Executeメソッドを実行すると、キーワードがヒットした場合、その箇所が選択された状態になる。この性質を利用して、Selection.Rangeを参照し、返ってきたRangeオブジェクトを返す。

検索でヒットしなければ、Find.FoundプロパティがFalseを返すので、その場合はNothingを返すことになる。

このメソッドを用いて取得したキーワード部分の[Range].Textプロパティをカッコ付きの文字列に書き換えてやる。

キーワード部分をカッコ付きにする

スト2
Private Sub test00()
  Const NAKED_AHO As String = "アホ"
  Const AHO_WITH_BRACKET As String = "[アホ]"
  Dim str1 As String, str2 As String
  str1 = NAKED_AHO: str2 = AHO_WITH_BRACKET
	Call clearFindObject
  Dim orgRange As Range
  Set orgRange = Selection.Range
  Dim tgtRange As Range
  Set tgtRange = getNextRange(str1)
  Do While Not tgtRange Is Nothing
    tgtRange.Font.NameFarEast = "MS ゴシック"
    Call replaceText(str1, str2)
    Set tgtRange = getNextRange(str1)
  Loop
  Call orgRange.Select
	Call clearFindObject
End Sub

'Findオブジェクトリセット用メソッド'
Private Sub clearFindObject()
  With Selection.Find
    Call .ClearFormatting
    Call .Replacement.ClearFormatting
  End With
End Sub
'文字列置換用メソッド'
Private Sub replaceText(ByVal str1 As String, _
                        ByVal str2 As String)
  'Findオブジェクトをクリア'
  Call clearFindObject
  '選択範囲を先頭方向に向かって潰す'
  Call Selection.Collapse(wdCollapseStart)
  Call Selection.Find.Execute(FindText:=str1, _
                              ReplaceWith:=str2, _
                              Replace:=wdReplaceOne)
  '選択範囲を終端報告に向かって潰す'
  Call Selection.Collapse(wdCollapseEnd)
  'Findオブジェクトをクリア'
  Call clearFindObject
End Sub

ドキュメント内の「アホ」を「[アホ]」に書き換えるマクロ。ついでにフォントをゴシック体に返るようにしている。

実行

f:id:akashi_keirin:20200219075242j:plain

このようなドキュメント(笑)を用意し、上掲のリスト2を実行する。

f:id:akashi_keirin:20200219075246g:plain

こんな感じ。

もちろん、「アホ」という文字列は問答無用で「[アホ]」に書き換えてしまうので、「ドリルアホールパイルドライバー」が「ドリル[アホ]ールパイルドライバー」になるというまぬけなことも起こるw

おわりに

鋭い方は既にお気づきのことと思うが、単に「アホ」を「[アホ]」に書き換えるだけのことなら、

Private Sub test02()
  Const NAKED_AHO As String = "アホ"
  Const AHO_WITH_BRACKET As String = "[アホ]"
  Dim orgRange As Range
  Set orgRange = Selection.Range
  Call clearFindObject
  With Selection.Find
    Call .Execute(FindText:=NAKED_AHO, _
                  ReplaceWith:=AHO_WITH_BRACKET, _
                  Replace:=wdReplaceAll)
  End With
  Call clearFindObject
  Call orgRange.Select
End Sub

で同じことができるんですけどねw

ち~んw