Office関連

変更履歴をオンにしたままで文字列の置換を行うWordマクロ

MSDNフォーラムに、“変更履歴をオンにした状態で文字列を置換するマクロを実行したところ、履歴として残っている削除済みの文字列もヒットしてしまうので上手く処理できない”、との質問がありました。

これはWordマクロを扱う人の間ではよく知られるWordの仕様で、Word MVPの新田さんのブログにサンプルコードコードも含めて対処法がまとめられています。

変更履歴をオンにしたままで文字修正(置換や書き換えなど)を行うマクロを実行する場合には注意が必要ですね。他のマクロでも同じことが起こりえます。

以下の2つにご注意ください。

1.変更履歴をオンにした場合、文字列を書き直した場合でも履歴として削除したはずの文字列がデータとして残ります。そこで、削除済みの文字列を検索対象から除外する場合には、削除済みの文字列を非表示にします。

ところが、Rangeオブジェクトで文字列を検索すると、削除済みの文字列を非表示にした場合でもヒットしてしまいます。Selectionオブジェクトで検索をする場合には、削除済みの文字列を非表示にしておけばヒットしません。

2.変更履歴をオンにした場合、ワイルドカードを用いた置換は誤変換が起こることがあります。

https://www.wordvbalab.com/code/1945/ より

要するに変更履歴の表示をオフにしてから処理すれば良いわけですが、ふと「変更履歴の種類を判別して“削除”を除外すれば良いのではないか?」と思いついたので、実際に試してみることにしました。

(Revision).Typeプロパティによる変更履歴の種類判定

さっそく書いたテスト用のコードが下記になります。
本文中の「Word」文字列を検索して、ヒットしたRangeオブジェクトから変更履歴を表すRevisionオブジェクトを取得、Typeプロパティで変更履歴の種類を取得するコードです。

Public Sub Test()
  Dim rng As Word.Range
  
  Set rng = ActiveDocument.Range
  With rng.Find
    .Text = "Word"
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchFuzzy = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = False
    Do While .Execute
      rng.Select
      Debug.Print "Revisions.Count:" & rng.Revisions.Count, _
                  "Revision.Type:" & rng.Revisions(1).Type
      Stop
    Loop
  End With
End Sub

実行した結果は下図の通りです。

種類はすべて“削除”を表す「2 (wdRevisionDelete)」となり、それどころか変更履歴が無い部分さえも変更履歴数が「1」となっています。

なんでだよ!?

思わずツッコんでしまいます。
さすが有名なWordの挙動、一筋縄ではいかないようです。

XMLからの情報取得

このようなとき、私はよくSelectionオブジェクトやRangeオブジェクトのXMLプロパティから取得できる情報を使います(下記記事参照)。

今回も変更履歴の“削除”と“挿入”でXMLの比較をしたところ、aml:annotation要素のw:type属性の値で判別できそうだという事が分かりました。

“削除”のXML
<w:p wsp:rsidR="009F28A1" wsp:rsidRDefault="00D0652C">
  <aml:annotation aml:id="0" w:type="Word.Deletion" aml:author="***" aml:createdate="2021-01-28T10:32:00Z">
    <aml:content>
      <w:r wsp:rsidDel="00227F40">
        <w:rPr>
          <w:rFonts w:hint="fareast"/>
        </w:rPr>
        <w:delText>〇〇〇</w:delText>
      </w:r>
    </aml:content>
  </aml:annotation>
</w:p>
“挿入”のXML
<w:p wsp:rsidR="00AB545F" wsp:rsidRDefault="00982971">
  <aml:annotation aml:id="0" w:type="Word.Insertion" aml:author="***" aml:createdate="2021-01-28T14:24:00Z">
    <aml:content>
      <w:r>
        <w:t>〇〇〇</w:t>
      </w:r>
    </aml:content>
  </aml:annotation>
</w:p>

これを受けて最終的に出来上がったのが下記のコードです。

変更履歴をオンにしたままで文字列の置換を行うWordマクロ

Option Explicit

Public Sub Sample()
  Const SrcText As String = "Word" '置換元文字列
  Const DestText As String = "WordXXX" '置換先文字列
  
  ActiveDocument.Range(0, 0).Select
  With Selection.Find
    .ClearFormatting
    .Text = SrcText
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchFuzzy = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = False
    Do While .Execute
      If Selection.Range.Revisions.Count > 0 Then
        Select Case LCase(GetAnnotationType(Selection.XML))
          Case LCase("Word.Deletion") '変更履歴・削除を除外
          Case Else
            Selection.Text = DestText
            Selection.Collapse Direction:=wdCollapseEnd
        End Select
      Else
        Selection.Text = DestText
        Selection.Collapse Direction:=wdCollapseEnd
      End If
      DoEvents
    Loop
  End With
  Selection.HomeKey Unit:=wdStory
  MsgBox "処理が終了しました。", vbSystemModal + vbInformation
End Sub

Private Function GetAnnotationType(ByVal SourceXML As String) As String
  Dim elm As Object
  Dim ret As String
  
  With CreateObject("MSXML2.DOMDocument")
    .async = False
    If .LoadXML(SourceXML) = True Then
      If .getElementsByTagName("aml:annotation").Length > 0 Then
        Set elm = .getElementsByTagName("aml:annotation").Item(0)
        ret = elm.getAttribute("w:type")
      End If
    End If
  End With
  GetAnnotationType = ret
End Function

実行結果は下図の通りで、意図した通りに文字列を置き換えることができました。

というわけで、変更履歴の種類を判別して無事に置換処理できることが確認出来たわけですが、最初に挙げた、新田さんが紹介されている対処法の方が圧倒的にシンプルで良いですね!

2021年1月の人気記事前のページ

[Office Scripts]選択範囲の値をドロップダウンリストの項目にする方法次のページ

関連記事

  1. Office関連

    OneNote + Google Apps Scriptで定期的にWebサイトのキャプチャーを撮る方…

    「“OneNote”がアップデート、URLをメールで送るだけでスクリー…

  2. Office関連

    ファイルをBase64エンコード・デコードするVBAマクロ

    以前書いたファイルのBase64エンコード・デコード処理を行うVBAマ…

  3. アイコン一覧

    Office 2013 アイコン一覧(C)

    ・Office 2013 アイコン一覧 NUM…

  4. Office関連

    リボンのタブを選択するVBAマクロ

    マクロでリボンのタブを選択する方法として、ActivateTabやAc…

コメント

  • コメント (0)

  • トラックバックは利用できません。

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP