Question

我需要将MS Word文档置于第三方软件中，该软件无法识别＆＃34;跟踪更改＆＃34;标记。但我仍然需要保留划掉的文本和新添加的文本，以便我的同事知道原始版本是什么，改变是什么。

如果只有一个人编辑过Word文档，则以下宏可用。

Sub Macro1()

Dim chgAdd As Word.Revision

If ActiveDocument.Revisions.Count = 0 Then
    MsgBox "There are no revisions in this document", vbOKOnly
Else
    ActiveDocument.TrackRevisions = False
    For Each chgAdd In ActiveDocument.Revisions
        If chgAdd.Type = wdRevisionDelete Then
            chgAdd.Range.Font.StrikeThrough = True
            chgAdd.Range.Font.Color = wdColorDarkBlue
            chgAdd.Reject
        ElseIf chgAdd.Type = wdRevisionInsert Then
            chgAdd.Range.Font.Color = wdColorRed
            chgAdd.Accept
        Else
            MsgBox ("Unexpected Change Type Found"), vbOKOnly + vbCritical
            chgAdd.Range.Select ' move insertion point
        End If
    Next chgAdd
End If
End Sub

当其他人编辑已编辑的文档时，问题就开始了。在这种情况下，第二作者可以删除第一作者的添加（不是原始文本）。上面的宏，而不是删除它，将其转换为我的同事错误认为存在于原文中的划掉的文本。

我只想将已删除的原始文本转换为划掉的文本，而不是已删除的编辑（由另一位作者删除的一位作者编辑）。

以下是一个作者编辑文本时宏（如何正常工作）的示例。

In＆＃34; C＆＃34;您可以看到深蓝色划掉的文本是从原始文本中删除的内容，红色是已添加的内容。

现在让我们来看看当两个（或理论上更多）不同的编辑器编辑文本时会发生什么，宏在最后运行（而不是在中间）：

这个问题在＆＃34; C＆＃34;：＆＃34; plantes＆＃34;即使它不是原始文本的一部分，也会变成深蓝色划掉的文本。

如您所见，图2-C与图1-C不同。所以我希望更新的宏工作，以便图2-C与图1-C相同。

Answer 1

以下VBA代码循环遍历一系列修订版，检查修订版是插入还是删除。如果是，并且在循环的这一部分之前没有立即拒绝，则它检查当前作者是否也是先前修订的作者，因为如果它们是相同的则不存在冲突。

如果它们不相同，那么它会检查当前作者是否不是主要作者，以及当前版本是否与前一版本在同一范围内，这意味着它已被主要作者“覆盖”了修订版。在这种情况下，当前版本被拒绝。

或者，如果先前版本的作者不是主要作者，并且先前版本与当前版本在同一范围内，则前一版本已由主作者替换修订版，则先前版本将被拒绝

在循环中，如果修订版刚被拒绝，则代码会检查新的当前修订是否由作者不是主要作者并且紧邻先前的拒绝。如果是这种情况，新的当前修订也会被拒绝。

然后，您已经拥有的代码将在此代码完成后运行。

Sub CompareRevisionsRanges()
  Dim revs As word.Revisions
  Dim rev As word.Revision, revOld As word.Revision
  Dim rngDoc As word.Range
  Dim rngRevNew As word.Range, rngRevOld As word.Range
  Dim authMain As String, authNew As String, authOld As String
  Dim bReject As Boolean

  bReject = False
  Set rngDoc = ActiveDocument.content
  Set revs = rngDoc.Revisions
  If revs.Count > 0 Then
    authMain = revs(1).Author
  Else 'No revisions so...
    Exit Sub
  End If

  For Each rev In revs
    'rev.Range.Select  'for debugging, only
    authNew = rev.Author
    If rev.Type = wdRevisionInsert Or wdRevisionDelete Then
        Set rngRevNew = rev.Range
        'There's only something to compare if an Insertion
        'or Deletion have been made prior to this
        If Not rngRevOld Is Nothing Then
            'The last revision was rejected, so we need to check
            'whether the next revision (insertion for a deletion, for example)
            'is adjacent and reject it, as well
            If bReject Then
                If rngRevNew.Start - rngRevOld.End <= 1 And authNew <> authMain Then
                    rev.Reject
                End If
                bReject = False 'reset in any case
            End If

            'If the authors are the same there's no conflict
            If authNew <> authOld Then
                'If the current revision is not the main author
                'and his revision is in the same range as the previous
                'this means his revision has replaced that
                'of the main author and must be rejected.
                If authNew <> authMain And rngRevNew.InRange(rngRevOld) Then
                    rev.Reject
                    bReject = True
                'If the previous revision is not the main author
                'and the new one is in the same range as the previous
                'this means that revision has replaced this one
                'of the main author and the previous must be rejected.
                ElseIf authOld <> authMain And rngRevOld.InRange(rngRevNew) Then
                    revOld.Reject
                    bReject = True
                End If
            End If
        End If
        Set rngRevOld = rngRevNew
        Set revOld = rev
        authOld = authNew
    End If

  Next        
End Sub

Answer 2

您还可以转换所有更改，然后搜索并删除同时具有下划线和删除线属性的所有文本。

MS Word宏用于转换＆＃34;跟踪更改＆＃34;标记为文本

2 个答案: