追綜修訂模式轉為劃線模式

追綜修訂模式轉為劃線模式

原始來源：patenting a life
http://thinkpatent.blogspot.com/


patent amendment and word vba
To convert the track change formatting to regular word formatting.
The code will change deletion to strikethrough, deletion of 5 chars or less is denoted using [[ ]] . Insertion is formatted with underline.

Sub TypeAndStrike()
' Converts tracked revisions in the active document into "type and
' written by Chip Orange.
' modified by iFly
'
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
If chgAdd.Range.Characters.Count <= 5 Then
Dim temp1 As Range
Set temp1 = chgAdd.Range

chgAdd.Range.Font.StrikeThrough = False
chgAdd.Reject

temp1.InsertBefore ("[[")
temp1.InsertAfter ("]]")
MsgBox temp1.Text

Else
'normal change just strikthrough
chgAdd.Range.Font.StrikeThrough = True
chgAdd.Reject
End If
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

Another improvement to change the portion in active selection, instead on the whole document. Save the macro in normal.dot, add a command (tool-customize - look for macro) to the toolbar !!


Sub TypeAndStrike()
' Converts tracked revisions in the active document into "type and
' written by Chip Orange.
' modified by Ifly
' Only operate to selected area in word document

Dim chgAdd As Word.Revision
Dim iStart As Integer
Dim iEnd As Integer


iStart = Selection.Range.Start
iEnd = Selection.Range.End
Set myRange = ActiveDocument.Range(Start:=iStart, End:=iEnd)


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

For Each chgAdd In myRange.Revisions
If chgAdd.Type = wdRevisionDelete Then
If chgAdd.Range.Characters.Count <= 5 Then
Dim temp1 As Range
Set temp1 = chgAdd.Range

chgAdd.Range.Font.StrikeThrough = False
chgAdd.Reject

temp1.InsertBefore ("[[")
temp1.InsertAfter ("]]")


Else
'normal change just strikthrough
chgAdd.Range.Font.StrikeThrough = True
chgAdd.Reject
End If
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


Posted by ifly
at 4:21 PM