Document.Charactersコレクションの要素を一つづつ処理するのは大変(Word)

WordでDocument.Charactersオブジェクトを一つづつ処理するのは異様に時間がかかる

資料の修正箇所に網掛けをしたものと、同じ内容で網掛けのないバージョンを要求されることがある。

そして、網掛けありバージョンと網掛けなしバージョンが併立するということが起こる。

ここまではまあ良い。

ヒサンなのは次のようなケースだ。

  • 資料に再修正の指示が出る。
  • 再修正し、網掛けありバージョンと網掛けなしバージョンを作成する
  • 再修正を繰り返すうちに、どこかで保存のタイミングを誤る
  • 網掛けありバージョンと網掛けなしバージョンの内容にずれが生ずる

およそ、事務系の仕事をしていれば、誰でも経験するのではなかろうか。

VBAで網掛けを外す

……と、ここまで「網掛け」という養護を用いているが、実際にはHighLight機能を使うことにする。「蛍光ペン」というやつだ。白黒印刷すれば、網掛けとほぼ同じ効果なので、ひとまずこれで代用する。

やり方としては、DocumentオブジェクトのCharactersコレクションの要素を一つづつ取り出して、HighLightIndexプロパティがwdYellowだったらwdNoHighLightに変える、というだけのものとする。

リスト1 標準モジュール
Public Sub test()
  Dim winAPI As New WindowsAPI    '……(1)'
  Dim startTime As Long
  startTime = winAPI.getNowTickCount
  Dim Doc As Document    '……(2)'
  Set Doc = ThisDocument
  Dim targetChar As Range
  For Each targetChar In Doc.Characters    '……(3)'
    With targetChar
      If .HighlightColorIndex = wdYellow Then    '……(4)'
        .HighlightColorIndex = wdNoHighlight
      End If
    End With
  Next
  Dim endTime As Single    '……(5)'
  endTime = (winAPI.getNowTickCount - startTime) / 1000
  Call MsgBox("処理時間:" & endTime & vbCrLf & _
              "文字数 :" & Doc.Characters.Count)
End Sub

(1)からの3行

Dim winAPI As New WindowsAPI
Dim startTime As Long
startTime = winAPI.getNowTickCount

はお気になさらねえでくだせえ。

WinAPIクラスというのは、割とよく使うWindowsAPIの関数を、手軽に使えるように自作のクラスモジュールにまとめたもの。

ここでは、あの有名なGetTickCount関数をラップしていると思ってください。

メインの処理は(2)からの10行

Dim Doc As Document
Set Doc = ThisDocument
Dim targetChar As Range
For Each targetChar In Doc.Characters    '……(3)'
  With targetChar
    If .HighlightColorIndex = wdYellow Then    '……(4)'
      .HighlightColorIndex = wdNoHighlight
    End If
  End With
Next

Document.Charactersコレクションの要素を一つづつ取り出して、HighlightColorIndexプロパティの値によって処理を切り替えている。

Charactersコレクションの要素がCharacterオブジェクトではなくRangeオブジェクトだというあたりが注意かな。

中身も詳しく見ておく。(3)からの7行

For Each targetChar In Doc.Characters
  With targetChar
    If .HighlightColorIndex = wdYellow Then    '……(4)'
      .HighlightColorIndex = wdNoHighlight
    End If
  End With
Next

では、For Each ~ Nextを用いて、Charactersコレクションの要素一つ一つを処理する。

ループ内部では、(4)からの3行

If targetChar.HighlightColorIndex = wdYellow Then
  targetChar.HighlightColorIndex = wdNoHighlight
End If

で、Charactersコレクションの要素であるRangeオブジェクト(変数targetCharの中身)のHighlightColorIndexプロパティの値を調べ、値がwdYellowだったら、すなわち黄色マーカが施されていたら、HighlightColorIndexプロパティの値をwdNoHighlightに変える、すなわちマーカを除去する、という処理を行う。

残りの、(5)からの4行(実質3行)

Dim endTime As Single
endTime = (winAPI.getNowTickCount - startTime) / 1000
Call MsgBox("処理時間:" & endTime & vbCrLf & _
            "文字数 :" & Doc.Characters.Count)

は、(1)の続き。処理後の時間を取得して、処理に掛かった時間を表示するだけ。

実行

f:id:akashi_keirin:20181215104022j:plain

このようなWord文書を用意する。文書内には、ご覧のようにところどころ黄色マーカを施してあるw

この状態で、リスト1を実行してみる。ちなみに、画面左下の文字数カウントでは「1082文字」と出ている。

f:id:akashi_keirin:20181215104035j:plain

なんと、3.785秒もかかっている。しかも、なぜか文字数(正確にはDocument.Characters.Countの値だけど)は1218になっている。

おわりに

1000字チョイなんて、コンピュータにとっては屁みたいな文字数だと思ったのだが、なぜこんなにヒマがかかるのだろうか。

しかも、今回のコードは単にマーカ部分をマーカなしにするだけであり、ひとたび実行すると、元の状態を復元することはできない(WordのVBAの場合、アンドゥでそこそこ戻れるけど。)。

マーカあり/なしを切り替えるには、マーカされている部分を記憶しておく必要がある。そのためには状態を取得するためにCharactersオブジェクトの要素にアクセスする必要がある。

たぶん、やり方がマズいのだろうけど、何か良いやり方はないものか。