Document.Charactersコレクションの要素を一つづつ処理するのは大変(Word) - 素人がExcelVBAによる「一人働き方改革」に挑むブログ

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

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

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

ここまではまあ良い。

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

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

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

VBAで網掛けを外す

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

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

リスト１　標準モジュール

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)からの３行

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)からの７行

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)からの３行

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

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

残りの、(5)からの４行（実質３行）

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

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