マーカ部分をRange配列として取得する(Word)
Findオブジェクトを用いてマーカ部分を取得する
この記事
へのid:imihitoさんのコメントにより、Findオブジェクトを用いて「蛍光ペン」のところをRangeオブジェクトとして取得できるということを知った。
参考にしたのは『みんなのワードマクロ』様。
WordVBAのFindオブジェクトというやつは、どうもイメージしづらくて苦手だったんだが、この際だからまじめに取り組んでみようと思った。
いや、実は過去に一度、非常にまじめに取り組んだことがあるんですけどね……。
マーカ部分を配列にして返すFunction
マーカ部分をRangeオブジェクトの配列として保持しておけば、あとはそのHighlightColorIndexプロパティを切り替えるだけで網掛けの有無を切り替えることができる。
Findオブジェクトを使って検索すると、ヒットした部分が選択された状態になるので、Selectionオブジェクトという形で取得が可能になる。
その都度、Range型の配列にぶち込んで行けば良いと思った。
リスト１ 標準モジュール
Public Function getHighLightedRange( _
ByVal targetDocument As Document) As Range()
Application.ScreenUpdating = False
Dim targetRange As Range '……(1)'
Set targetRange = Selection.Range
Call targetDocument.Range(0, 0).Select '……(2)'
Call Selection.Find.ClearFormatting '……(3)'
Call Selection.Find.Replacement.ClearFormatting
With Selection.Find '……(4)'
.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 '……(5)'
Dim ar() As Range '……(6)'
Dim i As Long
i = 0
Do While Selection.Find.Found '……(7)'
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 '……(8)'
getHighLightedRange = ar
Application.ScreenUpdating = True
End Function
(1)の
Dim targetRange As Range Set targetRange = Selection.Range
は、コード実行時のカーソル位置を覚えさせておくだけのもの。
(8)の
Call targetRange.Select
で、コード開始時のカーソル位置にカーソルを置くため。
別になくても構わないが、これをしておかないと、実行するたびにカーソルが最後にヒットした場所に行くことになる。
(2)の
Call targetDocument.Range(0, 0).Select
で、文書の先頭にカーソルを置く。
(3)からの２行
Call Selection.Find.ClearFormatting Call Selection.Find.Replacement.ClearFormatting
は、Findオブジェクトの初期化。
で、大事なのは次。
(4)からの14行
With Selection.Find '……(4)' .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オブジェクトの設定。
たくさんプロパティがあるが、綴り字でだいたい何を設定しているのかは見当が付くと思う。
ForwardプロパティとHighlightプロパティだけがTrueになっているのが分かると思う。
これを、
これと見比べれば、今回何をどう設定したのかが分かると思う。
これでFindオブジェクトの設定は終わったので、あとは(5)の
Call Selection.Find.Execute
でFindオブジェクトのExecuteメソッドを実行する。
これは、上の画像の[次を検索]をクリックするのと同じ（Find.ForwardプロパティがTrueなので）。
まず、この時点で
こうなる。一つ目のマーカ部分が選択された状態。
ここからが処理の第二段階。
(6)からの３行
Dim ar() As Range Dim i As Long i = 0
で、ヒットしたRangeオブジェクトを受ける配列を準備。要素数が確定しないので、動的に宣言しておく。変数iは、後にReDimするために使う。
(7)からの７行
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
Do ～ Loopを用いて、マーカ部分をRangeオブジェクトとして拾い集めていく。
FindオブジェクトのFoundプロパティがTrueである場合、つまり、Find.Executeメソッドの結果、次のマーカ部分がヒットした場合にはブロック内に進むことになる。
ループ内部に入ると、まずReDim Preserveで配列の要素数を改定する。
Preserveを忘れると、非常にマヌケなことになるので注意。
Set ar(i) = Selection.Range
でヒットして選択されているRangeオブジェクトを配列に格納する。
次にループ内部に突入した場合に備えてiをインクリメントさせておいて、
Call Selection.Collapse(Direction:=wdCollapseEnd)
Selection.Collapseメソッドを使って複数選択状態になっているカーソルを文字のカンチャンに移動する。引数DirectionがwdCollapseEndなので、選択されていた箇所の一番末尾にカーソルが移動する。
んで、最後に
Call Selection.Find.Execute
再度Find.Executeメソッドを実行。
これで新たにマーカ部分がヒットしたら、再度ブロック内に突入するし、すでにヒットする部分がなければループを抜けることになる。
ループを抜けたら、全てのマーカ部分が配列にぶち込まれたことになるから、(8)からの２行
Call targetRange.Select getHighLightedRange = ar
で、もとあった位置にカーソルを戻し、配列をreturnしておしまい。
使ってみる
次のコードで使ってみる。
リスト２ 標準モジュール
Public Sub testGetHighLightedRange()
Dim Doc As Document
Set Doc = ActiveDocument
Dim highLightedRange() As Range
highLightedRange = getHighLightedRange(Doc)
Dim i As Long
For i = LBound(highLightedRange) To UBound(highLightedRange)
Debug.Print highLightedRange(i).Text
Next
End Sub
リスト１のgetHighLightedRangeの返り値として取得したRange配列をForループで回して、それぞれのTextプロパティの値をイミディエイト・ウインドウに、表示させる。
例によって、
このような文書を用意して実行してみる。
この通り、マーカ部分の文字列が表示された。
マーカ部分をRangeオブジェクトで取得できた証拠。
おわりに
これで、マーカのOn／Offが切り替え可能になった。
