在 Tracked Change 中显示最终建议的文本而不接受更改

Question

我正在尝试编写一个可以在跟踪更改中显示最终建议文本而无需接受更改的宏。

当前代码（修改自thedoctools.com）如下，仅对删除和插入类型使用修订对象：

Public Sub ExtractAllRevisionsToExcel()
    Dim oDoc As Document
    Dim xlApp As Excel.Application
    Dim xlWB As Excel.Workbook
    Dim oNewExcel As Worksheet
    Dim oRange As Range
    Dim oRevision As Revision
    Dim strText As String
    Dim index As Long
    Dim Title As String
    
    Title = "Extract All revisions to Excel"
    Set oDoc = ActiveDocument
    
    If ActiveDocument.Revisions.Count = 0 Then
        MsgBox "The active document contains no changes.", vbOKOnly, Title
        GoTo ExitHere
    End If
    
    Application.ScreenUpdating = True
    'Create a new excel for the revisions
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    Set xlWB = xlApp.Workbooks.Add 'create a new workbook
    Set oNewExcel = xlWB.Worksheets(1)
    
    With oNewExcel
        .Cells(1, 1).Formula = "Document"
        .Cells(1, 2).Formula = "Page"
        .Cells(1, 3).Formula = "line number"
        .Cells(1, 4).Formula = "Original Statement"
        .Cells(1, 5).Formula = "Statement Proposed"
        
        index = 1
        'Get info from each tracked change (insertion/deletion) from oDoc and insert in table
        For Each oRevision In oDoc.Revisions
            Select Case oRevision.Type
               'Only include insertions and deletions
                Case wdRevisionInsert, wdRevisionDelete
                    'In case of footnote/endnote references (appear as Chr(2)),
                    'insert "[footnote reference]"/"[endnote reference]"
                    With oRevision
                        'Get the changed text
                        strText = .Range.Text
                    
                        Set oRange = .Range
                        Do While InStr(1, oRange.Text, Chr(2)) > 0
                            'Find each Chr(2) in strText and replace by appropriate text
                            i = InStr(1, strText, Chr(2))
                            
                            If oRange.Footnotes.Count = 1 Then
                                strText = Replace(Expression:=strText, _
                                        Find:=Chr(2), Replace:="[footnote reference]", _
                                        Start:=1, Count:=1)
                                'To keep track of replace, adjust oRange to start after i
                                oRange.Start = oRange.Start + i
                        
                            ElseIf oRange.Endnotes.Count = 1 Then
                                strText = Replace(Expression:=strText, _
                                        Find:=Chr(2), Replace:="[endnote reference]", _
                                        Start:=1, Count:=1)
                                'To keep track of replace, adjust oRange to start after i
                                oRange.Start = oRange.Start + i
                            End If
                       Loop
                    End With
                    index = index + 1 'Add 1 to row
                    
                    'Insert data in cells in row
                    'The document name
                    .Cells(index, 1).Formula = oDoc.FullName & vbCr
                    'Page number
                    .Cells(index, 2).Formula = oRevision.Range.Information(wdActiveEndPageNumber)
                    'Line number - start of revision
                    .Cells(index, 3).Formula = oRevision.Range.Information(wdFirstCharacterLineNumber)
                    'Original section text
                    .Cells(index, 4).Formula = oRevision.Range.Paragraphs(1).Range.Text
                    'Proposed changes - THIS IS WHERE I WANT TO SEE THE PREVIEW OF THE FINAL SECTION AFTER CHANGE IS ACCEPTED
                    If oRevision.Type = wdRevisionInsert Then
                        .Cells(index, 5).Formula = strText
                        'Apply automatic color (black on white)
                        .Cells(index, 5).Font.Color = wdColorBlue
                    Else
                        .Cells(index, 5).Formula = strText
                        'Apply red color
                        .Cells(index, 5).Font.Color = wdColorRed
                    End If
            End Select
        Next oRevision
    End With
    
    'Repaginate
    ActiveDocument.Repaginate
    'Toggle nonprinting characters twice
    ActiveWindow.ActivePane.View.ShowAll = Not _
    ActiveWindow.ActivePane.View.ShowAll
    ActiveWindow.ActivePane.View.ShowAll = Not _
    ActiveWindow.ActivePane.View.ShowAll
    Application.ScreenUpdating = True
    Application.ScreenRefresh
    
    oNewExcel.Activate
    MsgBox ActiveDocument.Revisions.Count & " changes found. Finished creating the worksheet.", vbOKOnly, Title
    
ExitHere:
    Set oDoc = Nothing
    Set xlWB = Nothing
    Set xlApp = Nothing
    Set oNewExcel = Nothing
    Set oRange = Nothing
End Sub

变量 strText returns 只有我们在 oRevision.Range.Paragraphs(1) 中更改的部分。Range.Text，但是我想要一个变量 returns oRevision.Range.Paragraphs(1) 中的最终文本。Range.Text 在更改之后已接受，但不接受实际 Word 文档中的更改。

有没有办法得到这样一个变量，因为我只想在接受更改后预览最后一节，而不是接受更改。

Answer 1

甚至 Word 的宏记录器也可以为您提供代码：

  With ActiveWindow.View
    .ShowRevisionsAndComments = False
    .RevisionsView = wdRevisionsViewFinal
  End With

在 Tracked Change 中显示最终建议的文本而不接受更改

Display the final proposed text in Tracked Change without accepting the change

vba

ms-word

revision