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

Thanks, William! I'll try it out.

Val

"WilliamWMeyer" wrote:


"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.



Here is the code for a macro I wrote to do this a couple of years ago. I
just tested it and it works. The process is a little complicated.

1. Make sure Track Changes is turned *off* on the document you're working
on.

2. Run the macro below

3. Here's the complicated part. Even though they've now been given
independent formatting, if you accept or reject all the track changes in the
document now you would still lose the deletions or the insertions.
Therefore, what I found works is to start a new document, turn track changes
on for that (blank) doc, paste all the contents of the working doc into the
new (text comes in as a new, mega-insertion), then ACCEPT all changes in the
new.

--WilliamW


Sub StrikethroughDeletions()

Number = ActiveDocument.Revisions.Count
For x = 1 To Number
Set myRev = ActiveDocument.Revisions(x).Range
This = ActiveDocument.Revisions(x).Type
If This = 2 Then
myRev.Select
Selection.Font.StrikeThrough = True
End If
If This = 1 Then
myRev.Select
Selection.Font.Underline = True
End If
Next x

End Sub