文書中のハイライトされた箇所を取得するFunction
文書中のハイライトされた箇所を取得するFunctionについては、かつて
このような形で取り上げたことがあった。
しかし、ハイライト箇所を文書本体、テキストボックスごとにRange配列として取得するよりも、個々のRangeオブジェクトをCollectionに叩き込むやり方の方が、取り扱いが簡単だと考えた。
そこで、単純に現在のカーソル位置の直後にあるハイライト箇所をRangeオブジェクトとして取得するメソッドを作成した。
次のハイライト箇所を取得するメソッド
コードを紹介する。
リスト1
Private Function getNextHighLight( _
ByVal currentRange As Range) As Range '……(1)'
Set getNextHighLight = Nothing '……(2)'
Dim ret As Range '……(3)'
'渡されたRangeオブジェクトにカーソルを置く'
Call currentRange.Select '……(4)'
'念のため選択箇所を潰しておく'
Call Selection.Collapse(wdCollapseStart)
With Selection.Find '……(5)'
Call .ClearFormatting
Call .Replacement.ClearFormatting
End With
'Findオブジェクトの諸設定'
With Selection.Find '……(6)'
.Text = ""
.Replacement.Text = ""
'これをwdFindStopにしておかないと、検索が終わらない'
'文書の最後にカーソルがあるときに、先頭から検索してしまう'
.Wrap = wdFindStop
.Format = False
.Highlight = True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
'検索実行'
Call Selection.Find.Execute '……(7)'
'ヒットしなければNothingを返す'
If Not Selection.Find.Found Then Exit Function '……(8)'
'返り値用変数に検索ヒットしたRangeオブジェクトをセット'
Set ret = Selection.Range '……(9)'
'次の検索用に選択範囲を後方に潰す'
Call Selection.Collapse(Direction:=wdCollapseEnd) '……(10)'
'返り値をセット'
Set getNextHighLight = ret '……(11)'
DoEvents
End Function
検索に用いるFindオブジェクトには、設定項目(プロパティ)が大量にあるので、タテ長になるのは致し方なし。まあ、スニペットとかにしておくと便利なのでしょうねえ。
(1)の
Private Function getNextHighLight( _
ByVal currentRange As Range) As Range
でメソッド名と引数を設定。
一応、Rangeオブジェクトを受け取って、そのRangeオブジェクトの直後にあるハイライト箇所をRangeオブジェクトとして返すようにした。
(2)の
Set getNextHighLight = Nothing
で初期値Nothingをセット。まあ、必要ないのだが、一応明示。
(3)の
Dim ret As Range
で返り値用変数を準備。
即Exitできるように(2)でgetNextHighLightにNothingをセットしてあるので、このretに初期値Nothingすることはしない。
(4)の
Call currentRange.Select Call Selection.Collapse(wdCollapseStart)
で、引数として渡されたRangeオブジェクトを選択。そして、次の検索のために、選択範囲を潰しておく。
まあ、実用上はまずこの引数にはSelection.Rangeを渡すことになるので回りくどいといえば回りくどい。ただ、一応、現在カーソルがあるところ以外のRangeオブジェクトを渡す場面も想定しておかないといけないと思うので、こうした。
(5)の
With Selection.Find Call .ClearFormatting Call .Replacement.ClearFormatting End With
でFindオブジェクトの諸設定をクリア。


この状態。
(6)の
With Selection.Find .Text = "" .Replacement.Text = "" .Wrap = wdFindStop .Format = False .Highlight = True .MatchCase = False .MatchWholeWord = False .MatchByte = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = False .MatchFuzzy = False End With
今回は、ハイライト部分を検索するので、検索文字列を表すTextプロパティ、置換後の文字列を表すReplacement.Textプロパティの値をともに""にしておく。
ハイライト箇所を検索したいので、HighlightプロパティをTrueにする。
で、注意せねばならんのがWrapプロパティの設定値。
この値がwdFindContinueになっていると、文書等の最後の検索箇所以降にカーソルがある状態で検索を実行したときに、文書等の先頭に戻って検索してしまう。
ここまでで、検索の準備が完了。
いよいよ(7)の
Call Selection.Find.Execute
で検索を実行。
検索対象(ハイライトされた箇所)があれば、その部分が選択された状態になる。
(8)の
If Not Selection.Find.Found Then Exit Function
ここで、FindオブジェクトのFoundプロパティを調べる。
検索対象が見つかっていなければ、FoundプロパティがFalseになるので、即Exit。これでNothingが返る。
ここを通過したときは、検索対象が見つかっているということなので、(9)の
Set ret = Selection.Range
選択されている箇所、すなわちハイライトされている箇所を返り値用変数retに突っ込む。
ここからは後始末。
検索終了時点で、ハイライトされている箇所が選択された状態になっているので、
(10)の
Call Selection.Collapse(Direction:=wdCollapseEnd)
で選択箇所を後方に向けて潰す。
最後に(11)の
Set getNextHighLight = ret
で返り値をセットしておしまい。
使ってみる

このようなドキュメントを用意して、カーソルを先頭に置いておく。
この状態で次のコードを実行。
リスト2
Private Sub test02() Dim tmp As Range Set tmp = getNextHighLight(Selection.Range) Debug.Print tmp.Text End Sub
実行後、イミディエイトは

この状態。ちゃんとハイライト箇所が取得できている。
んで、

おわかりだろうか。ハイライト箇所の終端と次の文字のカンチャンにカーソルが移動している。
おわりに
これで、ハイライト箇所がどこにあろうと、Rangeオブジェクトを渡しさえすれば、同じRangeオブジェクトとして取得することができる。
ただし、ハイライト部分の検索にはちょっとヤバい挙動がある(たぶん)ので、このメソッドをそのままDo ~ Loopで使おうとすると、場合によってはかなりひどいことが起こります(たぶん)。気をつけましょう。