In my work it would often be helpful to be able to convert what I see on the screen as tracked changes into text that I can paste into emails or other locations. The macro below accomplishes precisely this. I started with information on http://www.pcreview.co.uk/forums/converting-track-changes-marking-new-document-content-t3827219.html, but I found two significant limitations: the original code only worked on the whole document rather than a selection, and it converted everything to black and white.
My macro below works only on selected text and in making the untracking conversion, it formats the text red or blue. Note that I have not extensively tested this code and I provide it "as is" with no promises or warranties. I merely make it publicly available because I have not found similar code to meet my needs.
Sub TMC_untrack()
' TMC_UnTrack Macro
'
' Copyright Taras M. Czebiniak, (c) 8/28/14, may be used and shared without
' further permission but only on the condition that this copyright notice
' is always retained. YOUR USE OF THIS CODE IS ON AN "AS IS" BASIS AND
' ALL WARRANTIES EXPRESS OR IMPLIED ARE HEREBY DISCLAIMED.
ActiveDocument.TrackRevisions = False
'With ActiveDocument
With ActiveDocument
Dim arev As Revision
' With ActiveDocument
With Selection.Range
For Each arev In .Revisions
If arev.Type = wdRevisionDelete Then
arev.Range.Font.StrikeThrough = True
arev.Range.Font.ColorIndex = wdRed
arev.Reject
ElseIf arev.Type = wdRevisionInsert Then
arev.Range.Font.Underline = wdUnderlineDouble
arev.Range.Font.ColorIndex = wdBlue
arev.Accept
End If
Next arev
End With
End With
'With ActiveDocument.StoryRanges(wdPrimaryHeaderStory)
'....
'End With
'With ActiveDocument.StoryRanges(wdPrimaryFooterStory)
'....
'End With
End Sub
My macro below works only on selected text and in making the untracking conversion, it formats the text red or blue. Note that I have not extensively tested this code and I provide it "as is" with no promises or warranties. I merely make it publicly available because I have not found similar code to meet my needs.
Sub TMC_untrack()
' TMC_UnTrack Macro
'
' Copyright Taras M. Czebiniak, (c) 8/28/14, may be used and shared without
' further permission but only on the condition that this copyright notice
' is always retained. YOUR USE OF THIS CODE IS ON AN "AS IS" BASIS AND
' ALL WARRANTIES EXPRESS OR IMPLIED ARE HEREBY DISCLAIMED.
ActiveDocument.TrackRevisions = False
'With ActiveDocument
With ActiveDocument
Dim arev As Revision
' With ActiveDocument
With Selection.Range
For Each arev In .Revisions
If arev.Type = wdRevisionDelete Then
arev.Range.Font.StrikeThrough = True
arev.Range.Font.ColorIndex = wdRed
arev.Reject
ElseIf arev.Type = wdRevisionInsert Then
arev.Range.Font.Underline = wdUnderlineDouble
arev.Range.Font.ColorIndex = wdBlue
arev.Accept
End If
Next arev
End With
End With
'With ActiveDocument.StoryRanges(wdPrimaryHeaderStory)
'....
'End With
'With ActiveDocument.StoryRanges(wdPrimaryFooterStory)
'....
'End With
End Sub
No comments:
Post a Comment