Vba 用于转换的MS Word宏；跟踪变化”；将标记转换为文本

我被要求将MS Word文档置于不识别“跟踪更改”标记的第三方软件之下。但我仍然需要保留删去的文本和新添加的文本，以便我的同事知道什么是原始版本，什么是更改

如果只有一个人编辑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

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

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

下面是一个示例，说明了当文本由一位作者编辑时宏是如何（正确）工作的

在“C”中，您可以看到，深蓝色划掉的文本是从原始文本中删除的文本，红色是添加的文本

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

问题在“C”中变得很明显：“plantes”一词变成了深蓝色的略过文本，尽管它不是原始文本的一部分

---

正如您所看到的，图2-C与图1-C不同。因此，我希望更新后的宏能够工作，以便图2-C与图1-C相同。

以下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

子比较器VisionRanges（）
将转速调暗为word.Revisions
Dim rev As word.Revision，revOld As word.Revision
作为字范围的Dim rngDoc
将rngRevNew设置为word.Range，将RNGROVLD设置为word.Range
将authMain设置为字符串、authNew设置为字符串、authOld设置为字符串
布尔型模糊对象
bject=False
设置rngDoc=ActiveDocument.content
设置转速=rngDoc.修订
如果转速计数>0，则
authMain=revs（1）。作者
否则没有修改，所以。。。
出口接头
如果结束
每转每转
“rev.Range.Select”仅用于调试
authNew=rev.Author
如果版本类型=wdRevisionInsert或wdRevisionDelete，则
设置rngRevNew=版本范围
“只有在插入时才能进行比较
'或在此之前已删除
如果不是，那么rngRevOld什么都不是
“上一次修订被拒绝，因此我们需要检查
'是否为下一个修订版（例如，插入以删除）
“是相邻的，也拒绝它
如果是布列杰特的话
如果rngRevNew.Start-rngRevOld.End您还可以转换所有更改，然后搜索并删除所有同时具有underline和strike through属性的文本
 我有点像你想要的，但是我在概念上对应用的逻辑有困难。当前宏关闭轨迹更改-何时再次打开？宏如何知道此状态（已编辑一次）何时存在？宏是在多个编辑器更改的文档上运行，还是一次只在一个编辑器中运行？此处涉及Word的哪个版本？@Cindymister track更改不会再次被打开。它将在多个编辑器更改的文档上运行（这也是我想要的），但问题是它无法区分第二个编辑器是删除了第一个编辑器的添加内容还是原始文本。我希望它忽略后者（基本上不接受它）我仍然不确定我是否100%理解，所以需要与您进一步探讨这一点。。。1.有一份文件。2.有人用TrackChanges编辑它。3.您的代码正在运行，跟踪更改已关闭。4.另一个人编辑，但不更改轨迹。目标：检测（4）中所做的更改。问题只针对以前的更改，还是贯穿整个文档？如果不需要更改，为什么另一个人要编辑？保护整个文档或宏进行更改的位置有意义吗？或者最好将（3）的副本与（4）的结果进行比较？@Cindymister这些步骤实际上是按顺序进行的：1。有一份文件。2.有人用TrackChanges编辑它。3.另一个人进行编辑，但“轨迹更改”仍处于启用状态，并在此期间更改以前编辑器的“轨迹更改”。4.代码运行并跟踪更改被关闭。在这种情况下，文档中有多个“编辑器”处于活动状态，而您只想“转换”一个编辑器的更改，而丢弃其余的更改？还是只丢弃对相同文本范围所做的更改？如果最后一个是真的，那么您的代码是否会以相同的方式处理任何编辑器所做的任何其他更改？这一信息真的很重要