View Single Post
  #4   Report Post  
Posted to microsoft.public.word.formatting.longdocs
Chip Orange Chip Orange is offline
external usenet poster
 
Posts: 14
Default Convert Track Change Format to "Regular" Word Format


"vsingler" wrote in message
...
Is there a way to "convert" text with track change's underline and
strikethrough formats to text with "regular" underline and strikethrough
format?

We have a document that has been edited with Track Changes turned on -
insertions show with underline and deletions show with strikethrough.The
document's author wants all readers (inside and outside the company) to
see
underlines and deletions formatted in two specific colors and formats but
doesn't want other users' track change preferences to influence the
display.
He also doesn't want to have to manually format the changes. We tried a
"find
& replace" to try to find text with underlined formatting, but it could
only
find the character formatting, not track changes' version of underlining.

Thanks, in advance. Any suggestions would be much appreciated.


And in addition to the macro you've already been given, here's a slight
variation that prevents you from having to do the document copy/paste:

Sub TypeAndStrike()
'
' Converts tracked revisions in the active document into "type and
strike" format.
' It removes all tracked revisions.
'
' written by Chip Orange.
'
Dim chgAdd As Word.Revision

' disable tracked revisions.
If ActiveDocument.Revisions.Count = 0 Then
MsgBox "There are no revisions in this document", vbOKOnly
Else
ActiveDocument.TrackRevisions = False

For Each chgAdd In ActiveDocument.Revisions
If chgAdd.Type = wdRevisionDelete Then
' It's a deletion, so make it strike through and then reject the
change (so the text isn't lost).
chgAdd.Range.Font.StrikeThrough = True
chgAdd.Reject
ElseIf chgAdd.Type = wdRevisionInsert Then
' It's an addition, so underline it.
chgAdd.Range.Font.Underline = wdUnderlineSingle
chgAdd.Accept
Else
MsgBox ("Unexpected Change Type Found"), vbOKOnly + vbCritical
chgAdd.Range.Select ' move insertion point
End If

Next chgAdd
End If


End Sub