Adding Formatting to Insert and Delete Export for Track Changes

K

Krumrei

I got this piece of a MACRO that will allow me to extract the Inserted and
Deleted items in a new document.

However, I need it to also extract other revisions such as format, style and
grammer to the code.

Here is what I have for the Insert and Deleted Track changes in word.


The Case wdRevisionInsert, wdRevisionDelete is already there, but when I add
something like wdRevisionsmarking it does not pull the formatted changes on
the Track Changes report within the document.









'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
'Add 1 to counter
n = n + 1
'Add row to table
Set oRow = oTable.Rows.Add

'Insert data in cells in oRow
With oRow
'Page number
.Cells(1).Range.Text = _
oRevision.Range.Information(wdActiveEndPageNumber)

'Line number - start of revision
.Cells(2).Range.Text = _

oRevision.Range.Information(wdFirstCharacterLineNumber)

'Type of revision
If oRevision.Type = wdRevisionInsert Then
.Cells(3).Range.Text = "Inserted"
'Apply automatic color (black on white)
oRow.Range.Font.Color = wdColorAutomatic
Else
.Cells(3).Range.Text = "Deleted"
'Apply red color
oRow.Range.Font.Color = wdColorRed
End If
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top