使用单词通配符查找未接受的更改

时间:2016-09-19 10:15:54

标签: vba ms-word wildcard

我有一些word文档包含未经接受的跟踪更改。我想接受它们,但仍然在我的文档中以红色显示它们。我认为一个好方法是做一个通配符搜索未接受的更改并用红色的相同文本替换它们,但我不知道这是否可行。 我也很高兴其他方法可以实现我的目标,没有通配符。

1 个答案:

答案 0 :(得分:0)

使用Word的标准查找功能无法将格式应用于修订版。更换操作。但是,您可以编写一个枚举所有修订版的宏,然后对每个修订版应用格式。

Chris Rae提供了一个集团帖子,他提供了一个将修订版转换为标准格式的宏:

  

Enumerating edits on large documents (AKA converting tracked changes to conventional formatting)

宏可能还没有完全按照你的需要做,但它应该让你开始。

供参考,以下是宏的副本:

Sub EnumerateChanges()
    Dim rAll As Revision
    Dim dReport As Document
    Dim dBigDoc As Document

    Set dBigDoc = ActiveDocument

    If dBigDoc.Revisions.Count = 0 Then
        MsgBox "There are no revisions in the active document.", vbCritical
    ElseIf MsgBox(“This will enumerate the changes in '" + dBigDoc.Name + "' in a new document and close the original WITHOUT saving changes. Continue?", vbYesNo) <> vbNo Then
        Set dReport = Documents.Add

        dBigDoc.Activate ' really just so we can show progress by selecting the revisions
        dBigDoc.TrackRevisions = False ' Leaving this on results in a disaster

        For Each rAll In dBigDoc.Revisions
            ' Now find the nearest section heading downwards
            Dim rFindFirst As Range, rFindLast As Range
            Set rFindLast = rAll.Range.Paragraphs(1).Range
            While Not IsNumberedPara(rFindLast.Next(wdParagraph))
                Set rFindLast = rFindLast.Next(wdParagraph)
            Wend
            ' Now head back up to the next numbered section header
            Set rFindFirst = rFindLast
            Do
                Set rFindFirst = rFindFirst.Previous(wdParagraph)
            Loop Until IsNumberedPara(rFindFirst) Or (rFindFirst.Previous(wdParagraph) Is Nothing)
            ConvertNumberedToText rFindFirst

            Dim rChangedSection As Range
            Set rChangedSection = dBigDoc.Range(rFindFirst.Start, rFindLast.End)
            ' Properly tag all the revisions in this whole section
            Dim rOnesInThisSection As Revision
            For Each rOnesInThisSection In rChangedSection.Revisions
                rOnesInThisSection.Range.Select ' just for visual update
                DoEvents ' update the screen so we can see how far we are through
                If rOnesInThisSection.Type = wdRevisionDelete Then
                    rOnesInThisSection.Reject
                    With Selection.Range
                        .Font.ColorIndex = wdRed
                        .Font.StrikeThrough = True
                    End With
                    dBigDoc.Comments.Add Selection.Range, “deleted”
                Else
                    If rOnesInThisSection.Type = wdRevisionInsert Then
                        rOnesInThisSection.Accept
                        With Selection.Range
                            .Font.ColorIndex = wdBlue
                        End With
                        dBigDoc.Comments.Add Selection.Range, “inserted”
                    End If
                End If
            Next

            ' Now copy the whole thing into our new document
            rChangedSection.Copy
            Dim rOut As Range
            Set rOut = dReport.Range
            rOut.EndOf wdStory, False
            rOut.Paste
        Next rAll

        ' There should end up being no numbered paragraphs at all in the 
        ' new doc (they were converted to text), so delete them
        Dim pFinal As Paragraph
        For Each pFinal In dReport.Paragraphs
            If IsNumberedPara(pFinal.Range) Then
                pFinal.Range.ListFormat.RemoveNumbers
            End If
        Next

        dBigDoc.Close False
    End If
End Sub

Sub ConvertNumberedToText(rOf As Range)
    If InStr(rOf.ListFormat.ListString, “.”) > 0 Then
        rOf.InsertBefore "Changes to section " + rOf.ListFormat.ListString + " "
    End If
End Sub

Function IsNumberedPara(rOf As Range) As Boolean
    If rOf Is Nothing Then ‘ if the document doesn’t have numbered sections, this will cause changes to be enumerated in the whole thing
        IsNumberedPara = True
    ElseIf rOf.ListFormat.ListString <> "" Then
        If Asc(rOf.ListFormat.ListString) <> 63 Then
            IsNumberedPara = True
        End If
    End If
End Function