テキストボックス内のハイライト部分をそれぞれ配列に格納して、Collectionにする(Word)
テキストボックス内のハイライト部分をそれぞれ配列に格納して、Collectionにする
意味の取りづらいタイトルですまない。
テキストボックス内のハイライト部分(Range
オブジェクト)をテキストボックスごとに配列にして、それぞれの配列をCollection
にぶち込もう、ということ。
余計にわからなくなったとしたら申しわけない。
ハイライト部分を保持するクラス
なぜかクラスモジュールを使う。
クラス名は「HighLightedRange
」にした。相変わらずクラスの命名のこつがわからない。
すでに作成済みのクラスモジュールのコードを全て載っけると異様に長くなるので、必要な部分のみ掲載する。
リスト1 クラスモジュール
'Variable' Private ParentDoc_ As Document Private HighLightedRangesInTextBox_ As Collection 'Properties' Public Property Get ParentDoc() As Document Set ParentDoc = ParentDoc_ End Property Public Property Get HighLightedRangesInTextBox() As Collection Set HighLightedRangesInTextBox = HighLightedRangesInTextBox_ End Property 'Constructor' Private Sub Class_Initialize() Set ParentDoc_ = ActiveDocument End Sub Public Sub init(ByVal targetDocument As Document) Set ParentDoc_ = targetDocument End Sub 'Methods' Public Sub getHighLightedRangesInTextBox() Dim targetShape As Word.Shape 'Collectionオブジェクトのインスタンスを準備' Set HighLightedRangesInTextBox_ = New Collection 'Shapeオブジェクトを一つづつスキャン' For Each targetShape In ParentDoc_.Shapes Application.ScreenUpdating = False Dim ar() As Range Dim i As Long i = 0 '捕まえたShapeオブジェクトがテキストボックスだったら処理' If targetShape.Type = msoTextBox Then 'テキストボックスが文字列を持っていたら処理' If targetShape.TextFrame.HasText Then '一旦文字列全体を選択' targetShape.TextFrame.TextRange.Select '選択範囲を先頭方向に向って潰す' Call Selection.Collapse(Direction:=wdCollapseStart) 'Findオブジェクトを初期化' Call resetFindObject(Selection.Find) '必要なプロパティを設定' Selection.Find.Highlight = True '検索実行' Call Selection.Find.Execute 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 End If End If '上のDoループで作成された配列をCollectionに追加' Call HighLightedRangesInTextBox_.Add(ar) Application.ScreenUpdating = True Next End Sub 'Findオブジェクトのリセット用Privateメソッド' Private Sub resetFindObject(ByRef targetFind As Find) With targetFind Call .ClearFormatting Call .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
コード中のresetFindObject
メソッドについては、
コチラをご覧ください。
getHighLightedRangesInTextBox
メソッドが、テキストボックスのハイライト部分を配列化→配列のコレクション化を行う。処理の内容については、コード中にかなり細かくコメントを入れたので、そちらをよく読んでくだされ。
簡単に説明すると、
コチラでご紹介したやり方でもって、テキストボックスの文字列の先頭にカーソルを置いて、あとは
コチラでご紹介したやり方でハイライト部分(Range
オブジェクト)を配列にぶち込んでいっている。
このときと違うのは、さらにその配列をCollection
にぶち込んでいる、というだけ。
使ってみる
このように、テキストボックスを二つ設置したDocumentを用意して、次のコードを実行してみる。
リスト1 標準モジュール
Public Sub test() Dim highLightedRange_ As New HighLightedRange With highLightedRange_ .getHighLightedRangesInTextBox End With End Sub
もちろん、単にこのコードを実行しただけだと、表面上何も起こらない。
配列を作ってCollection
にぶち込んでいるだけだし、そのCollection
にしたところで、実行後は破棄されてしまうのだから。
従って、End Sub
のところにブレークポイントを設定してコードの実行を中断し、イミディエイト・ウインドウに次のように打ち込んで[Enter]し、変数の内容を調べてみる。
?highLightedRange_.HighLightedRangesInTextBox(1)(0).Text
?highLightedRange_.HighLightedRangesInTextBox(1)(1).Text
?highLightedRange_.HighLightedRangesInTextBox(1)(2).Text
?highLightedRange_.HighLightedRangesInTextBox(1)(3).Text
?highLightedRange_.HighLightedRangesInTextBox(2)(0).Text
?highLightedRange_.HighLightedRangesInTextBox(2)(1).Text
鋭い方なら三つ目と四つ目に「?」となるだろうが、実行結果を見てほしい。
実行結果
なぜか、このような結果になる。
一つ目のテキストボックスは、ハイライト箇所が2箇所しかないのに、その2箇所が二重に取得されてしまっている。
二つ目のテキストボックスはちゃんと取得されているのに。
なぜこうなるのか、全然わかりません。
おわりに
実は、今回のHighLightedRange
クラスに、次のメソッドを追加して、上記getHighLightedRangesInTextBox
メソッド実行後に実行すると、おかしなことが起こる。
toggleHighLightInTextBoxメソッド
Public Sub toggleHighLightInTextBox() Dim i As Long For i = 1 To HighLightedRangesInTextBox_.Count Dim j As Long For j = LBound(HighLightedRangesInTextBox_(i)) To _ UBound(HighLightedRangesInTextBox_(i)) With HighLightedRangesInTextBox_(i)(j) If .HighlightColorIndex = wdYellow Then .HighlightColorIndex = wdNone Else .HighlightColorIndex = wdYellow End If End With Next Next End Sub
getHighLightedRangesInTextBox
メソッドで取得したRange
オブジェクト一つ一つのHighlight
プロパティの値を調べて、必要に応じて設定し直すだけのしょうもないメソッドなのに、なぜかこれを実行すると、私の環境(Windows10 64Bit & Word2013 32Bit)ではWordが強制終了されてしまうのである。
しかも、Wordが自動的に再起動した後、標準モジュールやクラスモジュールの復元に失敗したらしく、間違えて上書き保存してしまってせっかく書いたコードが一度失われるという悲劇に……。
ホントにわけわかんないんですけど……。