Findオブジェクトの設定をリセットするメソッド
Findオブジェクトの設定をリセットするメソッド
このとき
のリスト1で、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オブジェクトを初期化するメソッド
上掲のリスト1では、「蛍光マーカ」の有無を表すプロパティ(Highlight
)のみTrue
にしていた。蛍光マーカの有無だけを調べたかったのでそうしている。つまり、それ以外は初期設定だとみなせるということ。したがって、Highlight
プロパティをFalse
にしておけば、まさに初期化状態、ということだ。
リスト2 標準モジュール
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)の
Call resetFindObject(Selection.Find)
でFind
オブジェクトを初期化し、
(2)の
Selection.Find.Highlight = True
でHighlight
プロパティのみ設定。
あのくっそ長かったFind
オブジェクト準備用コードがすっげー短くなった。
おわりに
これでより一層Find
オブジェクトが使いやすくなったなあ。