テキストボックス内のハイライト部分をそれぞれ配列に格納して、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メソッドについては、

akashi-keirin.hatenablog.com

コチラをご覧ください。

getHighLightedRangesInTextBoxメソッドが、テキストボックスのハイライト部分を配列化→配列のコレクション化を行う。処理の内容については、コード中にかなり細かくコメントを入れたので、そちらをよく読んでくだされ。

簡単に説明すると、

akashi-keirin.hatenablog.com

コチラでご紹介したやり方でもって、テキストボックスの文字列の先頭にカーソルを置いて、あとは

akashi-keirin.hatenablog.com

コチラでご紹介したやり方でハイライト部分(Rangeオブジェクト)を配列にぶち込んでいっている。

このときと違うのは、さらにその配列をCollectionにぶち込んでいる、というだけ。

使ってみる

f:id:akashi_keirin:20190103203239j:plain

このように、テキストボックスを二つ設置した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

鋭い方なら三つ目と四つ目に「?」となるだろうが、実行結果を見てほしい。

実行結果

f:id:akashi_keirin:20190103203253j:plain

なぜか、このような結果になる。

一つ目のテキストボックスは、ハイライト箇所が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が自動的に再起動した後、標準モジュールやクラスモジュールの復元に失敗したらしく、間違えて上書き保存してしまってせっかく書いたコードが一度失われるという悲劇に……。

ホントにわけわかんないんですけど……。