今日は選択範囲内で文字列検索を行うWordマクロについて考えてみます。

下図のように特定の範囲を選択した状態で、その範囲内のみを対象に文字列検索を行いたい場合どうするのか？まずは下記コードのようにSelectionオブジェクトからFindオブジェクトを取得して処理を行ってみます。

Public Sub Sample1()
  Const SearchWords As String = "文書"
  
  With Selection.Find
    .ClearFormatting
    .ClearAllFuzzyOptions
    .Text = SearchWords
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = False
    .MatchFuzzy = False
    Do While .Execute
      Selection.Range.HighlightColorIndex = wdRed
    Loop
  End With
End Sub

すると下図のように文章末まで検索処理が行われてしまいました。
SelectionオブジェクトからFindオブジェクトを取得した場合、文字列がヒットすると選択範囲が変更されてしまうので、これは当たり前の動作と言えます。

次はRangeオブジェクトからFindオブジェクトを取得して処理を行ってみます。

Public Sub Sample2()
  Dim r As Word.Range
  Const SearchWords As String = "文書"
  
  Set r = Selection.Range
  With r.Find
    .ClearFormatting
    .ClearAllFuzzyOptions
    .Text = SearchWords
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = False
    .MatchFuzzy = False
    Do While .Execute
      r.HighlightColorIndex = wdRed
    Loop
  End With
  Set r = Nothing
End Sub

上記コードを実行すると、これもまた先ほどのSelectionオブジェクトからの検索同様に文章末まで検索処理が行われているようです。

では、今度はInRangeメソッドを利用して”ヒットした文字列が選択範囲内だった場合のみ処理を行う“ようにしてみます。
InRangeメソッドは、

“メソッドが適用される範囲が引数 Range に指定した範囲内に含まれる場合、True を返します”

という説明にあるように、メソッドを実行した対象が指定した範囲内に含まれるかどうかを取得することができるメソッドです。

Public Sub Sample3()
  Dim r As Word.Range
  Const SearchWords As String = "文書"
  
  Set r = Selection.Range
  With r.Find
    .ClearFormatting
    .ClearAllFuzzyOptions
    .Text = SearchWords
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = False
    .MatchFuzzy = False
    Do While .Execute
      '選択範囲内の場合のみ処理実行
      If r.InRange(Selection.Range) Then
        r.HighlightColorIndex = wdRed
      End If
    Loop
  End With
  Set r = Nothing
End Sub

今度は上手くいっているようです。

ですがこの処理も”選択範囲が検索語と同じだった場合“には上手く処理することができません。

それではどうするのか？
これはもう単純に”選択範囲が検索語と同じだった場合“と”それ以外の場合“とに処理を分けてしまえば良いわけです。

Public Sub Sample4()
  Dim r As Word.Range
  Const SearchWords As String = "文書"
  
  Set r = Selection.Range
  '選択範囲が検索語と同じかどうかを判断
  If r.Text = SearchWords Then
    r.HighlightColorIndex = wdRed
  Else
    With r.Find
      .ClearFormatting
      .ClearAllFuzzyOptions
      .Text = SearchWords
      .Replacement.Text = ""
      .Forward = True
      .Wrap = wdFindStop
      .Format = False
      .MatchCase = False
      .MatchWholeWord = False
      .MatchByte = False
      .MatchAllWordForms = False
      .MatchSoundsLike = False
      .MatchWildcards = False
      .MatchFuzzy = False
      Do While .Execute
        '選択範囲内の場合のみ処理実行
        If r.InRange(Selection.Range) Then
          r.HighlightColorIndex = wdRed
        End If
      Loop
    End With
  End If
  Set r = Nothing
End Sub

これでようやく意図した通りに処理できるようになりました。

ただ、このコードにも無駄な部分があります。
それはヒットした場合の処理部分で、選択範囲が検索語と同じだった場合とそれ以外の場合の処理とで同じ処理を二重に書いているため、コードが冗長になってしまっています。
上記コードでは「r.HighlightColorIndex = wdRed」だけなのであまり気になるものではありませんが、これがもっと細かい処理になると、コードも見づらくなり修正する際の手間も増えてしまいます。
それではどうするのか？
こういったときは別途Subプロシージャを用意して処理をまとめてしまえば良いわけです。

Public Sub Sample5()
  Dim r As Word.Range
  Const SearchWords As String = "文書"
  
  Set r = Selection.Range
  '選択範囲が検索語と同じかどうかを判断
  If r.Text = SearchWords Then
    HitProc r
  Else
    With r.Find
      .ClearFormatting
      .ClearAllFuzzyOptions
      .Text = SearchWords
      .Replacement.Text = ""
      .Forward = True
      .Wrap = wdFindStop
      .Format = False
      .MatchCase = False
      .MatchWholeWord = False
      .MatchByte = False
      .MatchAllWordForms = False
      .MatchSoundsLike = False
      .MatchWildcards = False
      .MatchFuzzy = False
      Do While .Execute
        '選択範囲内の場合のみ処理実行
        If r.InRange(Selection.Range) Then
          HitProc r
        End If
      Loop
    End With
  End If
  Set r = Nothing
End Sub

Private Sub HitProc(ByRef r As Word.Range)
'ヒットした場合の処理
  r.Bold = True
  r.Italic = True
  r.Font.Color = wdColorWhite
  r.HighlightColorIndex = wdRed
End Sub

上記コードでは「HitProc」プロシージャによって処理をまとめているので、ヒットした場合の処理はたった1行”HitProc r“とだけ書けば良いわけです。
私もWordマクロに精通しているわけではなく、本当はもっと効率の良い方法があるのかもしれませんが、とりあえずこれで目的の処理ができるようになりました。

最後にもう一点、Word 2007で追加されたHitHighlightメソッドの場合はInRangeメソッドで範囲判定を行う必要なく、選択範囲のみを処理することができます。

Public Sub Sample6()
  Dim r As Word.Range
  Const SearchWords As String = "文書"
  
  Set r = Selection.Range
  With r.Find
    .ClearFormatting
    .ClearAllFuzzyOptions
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = False
    .MatchFuzzy = False
    .HitHighlight SearchWords
  End With
  Set r = Nothing
End Sub

HitHighlightメソッドはヒットした文字列を強調表示するだけなので、ヒットした文字列部分をオブジェクトとして取得できるExecuteメソッドとは用途が大きく異なるわけですが、こうした細かい動作の違いを覚えておくと、どこかで役に立つかもしれないですね。

2016/09/12 追記：
Collapseメソッドを入れることで検索語判定を入れることなく処理できることを教えていただきました。
If文がなくなるので大分スマートになりますね！

Public Sub Sample7()
  Dim r As Word.Range
  Const SearchWords As String = "文書"
   
  Set r = Selection.Range
  r.Collapse wdCollapseStart '<--追加
  With r.Find
    .ClearFormatting
    .ClearAllFuzzyOptions
    .Text = SearchWords
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = False
    .MatchFuzzy = False
    Do While .Execute
      '選択範囲内の場合のみ処理実行
      If r.InRange(Selection.Range) Then
        r.HighlightColorIndex = wdRed
      End If
    Loop
  End With
  Set r = Nothing
End Sub