MSDNフォーラムに、“変更履歴をオンにした状態で文字列を置換するマクロを実行したところ、履歴として残っている削除済みの文字列もヒットしてしまうので上手く処理できない”、との質問がありました。
これはWordマクロを扱う人の間ではよく知られるWordの仕様で、Word MVPの新田さんのブログにサンプルコードコードも含めて対処法がまとめられています。
変更履歴をオンにしたままで文字修正（置換や書き換えなど）を行うマクロを実行する場合には注意が必要ですね。他のマクロでも同じことが起こりえます。
以下の2つにご注意ください。
１．変更履歴をオンにした場合、文字列を書き直した場合でも履歴として削除したはずの文字列がデータとして残ります。そこで、削除済みの文字列を検索対象から除外する場合には、削除済みの文字列を非表示にします。
ところが、Rangeオブジェクトで文字列を検索すると、削除済みの文字列を非表示にした場合でもヒットしてしまいます。Selectionオブジェクトで検索をする場合には、削除済みの文字列を非表示にしておけばヒットしません。
２．変更履歴をオンにした場合、ワイルドカードを用いた置換は誤変換が起こることがあります。
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
実行結果は下図の通りで、意図した通りに文字列を置き換えることができました。
というわけで、変更履歴の種類を判別して無事に置換処理できることが確認出来たわけですが、最初に挙げた、新田さんが紹介されている対処法の方が圧倒的にシンプルで良いですね！
この記事へのコメントはありません。