vba - 在不接受更改的情况下在 Tracked Change 中显示最终建议的文本
问题描述
我正在尝试编写一个可以在跟踪更改中显示最终提议的文本而不必接受更改的宏。
当前代码(从 thedoctools.com 修改)如下,它仅将 Revision 对象用于 Delete 和 Insert 类型:
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仅返回我们在oRevision.Range.Paragraphs(1).Range.Text中更改的部分,但是我想要一个返回oRevision.Range.Paragraphs(1).Range.Text更改后的最终文本的变量已被接受,但不接受实际 Word 文档中的更改。
有没有办法获得这样的变量,因为我只想在接受更改后预览最后一部分,而不接受更改。
解决方案
甚至 Word 的宏记录器也可以为您提供代码:
With ActiveWindow.View
.ShowRevisionsAndComments = False
.RevisionsView = wdRevisionsViewFinal
End With
推荐阅读
- routes - Nuxt.js 中不同子域的不同路由
- express - REST API 路由器转发到 Apollo GraphQL 端点
- android - 使用 Emteria OS 将多设备应用程序部署到 RaspBerry Pi 3 时出现异常
- markdown - 使用 Pandoc 时禁用“TeX 数学”
- python - 在 TKinter 中显示 OpenAI Gym 环境渲染
- c++ - 标准库的 C++ 问题
- apache-kafka - Kafka Streams(抑制):通过超时关闭 TimeWindow
- struct - 如何在 Racket 中提供与结构相关的所有功能
- rest - REST 过滤和了解结果的最佳实践是单数:列表还是单数?
- dart - Flutter - 使用firstwhere搜索数组中的元素