Question

我编写了一个VBA例程，用于比较docx文件和保存delta。我需要停用增量中的TrackFormatting，但添加.trackFormatting = False不会执行任何操作。在比较方法中，CompareFormatting也是假的！我该怎么做？

Sub ProduceDeltas()
   Dim strFolderA As String
   Dim strFolderB As String
   Dim strFolderC As String
   Dim strFileSpec As String
   Dim strFileName As String
   Dim objDocA As Word.Document
   Dim objDocB As Word.Document
   Dim objDocC As Word.Document
   Dim dc As Word.Document
   Dim FldrPickerInputA As FileDialog
   Dim FldrPickerInputB As FileDialog
   Dim FldrPickerOutput As FileDialog
  Application.ScreenUpdating = False
  Set FldrPickerInputA = Application.FileDialog(msoFileDialogFolderPicker)
  Set FldrPickerInputB = Application.FileDialog(msoFileDialogFolderPicker)
  Set FldrPickerOutput = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPickerInputA
  .Title = "Choose first file: "
  .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    strFolderA = .SelectedItems(1) & "\"
   End With
   With FldrPickerInputB
  .Title = "Choose second file: "
  .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    strFolderB = .SelectedItems(1) & "\"
   End With
  With FldrPickerOutput
  .Title = "Choose output file: "
  .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    strFolderC = .SelectedItems(1) & "\"
 End With  

 NextCode:
 strFolderA = strFolderA
 strFolderB = strFolderB
 strFolderC = strFolderC
 If strFolderA = "" Then GoTo ResetSettings
 strFileSpec = "*.docx"
 strFileName = Dir(strFolderA & strFileSpec)
 Do While strFileName <> vbNullString
 Set objDocA = Documents.Open(strFolderA & strFileName)
 Set objDocB = Documents.Open(strFolderB & strFileName)
 If objDocA.TablesOfContents.Count = 1 Then _
   objDocA.TablesOfContents(1).Update
 If objDocB.TablesOfContents.Count = 1 Then _
   objDocB.TablesOfContents(1).Update
 Set dc = Application.CompareDocuments(objDocA, objDocB,           wdCompareDestinationNew, _
   Granularity:=wdGranularityWordLevel, _
   CompareFormatting:=False, RevisedAuthor:="IQTIG",        CompareFootnotes:=False,   CompareHeaders:=False)

dc.TrackFormatting = False
objDocA.Save
objDocB.Save
objDocA.Close
objDocB.Close

If dc.TablesOfContents.Count = 1 Then _
 dc.TablesOfContents(1).Update

dc.SaveAs strFolderC & strFileName
dc.Close SaveChanges:=False
strFileName = Dir
Loop

Set objDocA = Nothing
Set objDocB = Nothing

ResetSettings: 
Application.ScreenUpdating = True
End Sub

Answer 1

哪个版本的Word？在Word 2013上，CompareFormatting:=False适合我。

一种选择是在运行比较后接受（或拒绝）所有格式修订。在dc.SaveAs之前，插入以下内容：

dim oRevision as Revision
For Each oRevision In dc.StoryRanges(wdMainTextStory).Revisions
    If (oRevision.Type<> wdRevisionInsert) and (oRevision.type <> wdRevisionDelete) then
        oRevision.Accept    ' or .Reject
    End If
Next oRevision

（由Lene Fredborg从ExtractTrackedChangesToNewDoc修改的代码，按原样提供，不提供保修。）

比较Word文档而不跟踪格式更改

1 个答案: