Findオブジェクトの設定をリセットするメソッド

f:id:akashi_keirin:20190101084110j:plain

このとき

akashi-keirin.hatenablog.com

のリスト１で、Document内の黄色蛍光マーカ位置をRange配列として返すメソッドを作った。

その中で、Findオブジェクトを初期設定する部分、すなわち、

Call Selection.Find.ClearFormatting
Call Selection.Find.Replacement.ClearFormatting
With Selection.Find
  .Text = ""
  .Replacement.Text = ""
  .Forward = True
  .Wrap = wdFindContinue
  .Format = False
  .Highlight = True
  .MatchCase = False
  .MatchWholeWord = False
  .MatchByte = False
  .MatchAllWordForms = False
  .MatchSoundsLike = False
  .MatchWildcards = False
  .MatchFuzzy = False
End With

この部分が異様にタテ長で気に入らなかった。

Findオブジェクトを利用するたびに、こんなタテ長のブロックをいちいち書く（コピペする）となると非常にめんどくさい。

そこで、

一旦Findオブジェクトを初期化する
必要なプロパティのみ再設定する

というやり方を考えた。

Findオブジェクトを初期化するメソッド

上掲のリスト１では、「蛍光マーカ」の有無を表すプロパティ（Highlight）のみTrueにしていた。蛍光マーカの有無だけを調べたかったのでそうしている。つまり、それ以外は初期設定だとみなせるということ。したがって、HighlightプロパティをFalseにしておけば、まさに初期化状態、ということだ。

リスト２　標準モジュール

Public Sub resetFindObject(ByRef targetFind As Find)
  With targetFind
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .Highlight = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = False
    .MatchFuzzy = False
  End With
End Sub

Findオブジェクトを返すFunctionにすることも考えたが、返り値のFindオブジェクトをSelection.Findにセットするというのがよくわからなかったので、ByRef指定で直接Findオブジェクトを書き換える形にした。

このメソッドに一旦Selection.Findオブジェクトを渡してFindオブジェクトを書き換えておき、その後で、設定したいプロパティだけ設定すればよい。

前回のコードの修正

というわけで、前回のコードを修正してみる。

修正前

Public Function getHighLightedRange( _
         ByVal targetDocument As Document) As Range()
  Application.ScreenUpdating = False
  Dim targetRange As Range
  Set targetRange = Selection.Range
  Call targetDocument.Range(0, 0).Select
  Call Selection.Find.ClearFormatting
  Call Selection.Find.Replacement.ClearFormatting
  With Selection.Find
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .Highlight = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = False
    .MatchFuzzy = False
  End With
  Call Selection.Find.Execute
  Dim ar() As Range
  Dim i As Long
  i = 0
  Do While Selection.Find.Found
    ReDim Preserve ar(i)
    Set ar(i) = Selection.Range
    i = i + 1
    Call Selection.Collapse(Direction:=wdCollapseEnd)
    Call Selection.Find.Execute
  Loop
  Call targetRange.Select
  getHighLightedRange = ar
  Application.ScreenUpdating = True
End Function

で、お次が修正後。

修正前

Public Function getHighLightedRange( _
         ByVal targetDocument As Document) As Range()
  Application.ScreenUpdating = False
  Dim targetRange As Range
  Set targetRange = Selection.Range
  Call targetDocument.Range(0, 0).Select
  Call resetFindObject(Selection.Find)    '……(1)'
  Selection.Find.Highlight = True    '……(2)'
  Call Selection.Find.Execute
  Dim ar() As Range
  Dim i As Long
  i = 0
  Do While Selection.Find.Found
    ReDim Preserve ar(i)
    Set ar(i) = Selection.Range
    i = i + 1
    Call Selection.Collapse(Direction:=wdCollapseEnd)
    Call Selection.Find.Execute
  Loop
  Call targetRange.Select
  getHighLightedRange = ar
  Application.ScreenUpdating = True
End Function

(1)の