How do i write an Undo in a macro

[Shimon]

Hi,
I have a macro that inserts SEQ numbers under figures by replacing a string
" Figure:" with "Figure" + "SequenceNumber".
This code loops while the string is found. If it is not found then it exits
the SUB.
One problem is that it does not start the loop unless I do a find first.
The main problem righ now is that at the end it enters a second sequence
number before it exits.
I would like either to fix the loop so that it works properly, or to add an
undo right before the exist SUB statement.
Any help is greatl appreciated.
Should I post this code in the numbering newsgroup, or is this simple stuff
for VBA programmers.
Thanks,
Shimon

Sub hInsertNumLooped()
'Replaces the text " Figure: " with Figure: and a reference number
'in order to build a table of figures .
'
'
'

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " Figure: "
.Replacement.Text = "Figure: "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False

End With
Selection.Find.Execute Replace:=wdReplaceOne
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:=
_
"SEQ Figure \*ARABIC", PreserveFormatting:=True
Selection.TypeText Text:=" "




For i = 1 To 10000

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " Figure: "
.Replacement.Text = "Figure: "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
If Not .Found Then
MsgBox ("Fix the last figure number")

Exit Sub
End If
End With
Selection.Find.Execute Replace:=wdReplaceOne
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:=
_
"SEQ Figure \*ARABIC", PreserveFormatting:=True
Selection.TypeText Text:=" "






Next i
MsgBox ("Fix the last number and add a Table of figures")

End Sub

 

[Charles Kenyon]

This is the place to post code ... and without it being posted no one is
going to be able to give much help.
--
Charles Kenyon

Word New User FAQ & Web Directory: http://addbalance.com/word

Intermediate User's Guide to Microsoft Word (supplemented version of
Microsoft's Legal Users' Guide) http://addbalance.com/usersguide

See also the MVP FAQ: http://www.mvps.org/word which is awesome!
--------- --------- --------- --------- --------- ---------
This message is posted to a newsgroup. Please post replies
and questions to the newsgroup so that others can learn
from my ignorance and your wisdom.

 

[Doug Robbins]

Use

Dim i As Long
i = 1
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(FindText:="Figure", MatchWildcards:=False,
Wrap:=wdFindStop, Forward:=True) = True
Selection.InsertAfter " " & i
Selection.Collapse wdCollapseEnd
i = i + 1
Loop
End With

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

 

[Shimon]

Thanks Doug,
I'll try it soon. Meanwile, i figured out how to do an Undo in a macro.

Dim oDoc As Document
Set oDoc = ActiveDocument
oDoc.Undo

Shimon

 

[Shimon]

Hi Doug,
Your code works great and is much more elegant than mine.
Since I wanted to build a table of figures, I changed the entry to a field.
I'm enclosing the final code that i'm using.


Sub InsertNumberAfterFigure()
'
' zzzInsertNumberAfterFigure Macro
' Macro created ?12/05/2005 by Shimon
' to enter sequence numbers to enable the creation of a Table of figures.
' Done with the help of Doug Robbins
' and Greg Maxey
'
Dim i As Long
i = 1
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(FindText:=" Figure: ", MatchWildcards:=False,
Wrap:=wdFindStop, Forward:=True) = True
Selection.TypeText Text:="Figure: "
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, Text:= _
"SEQ Figure \*ARABIC", PreserveFormatting:=True
Selection.TypeText Text:=" "
Selection.Collapse wdCollapseEnd
i = i + 1
Loop
End With



End Sub


Thanks alot,
Shimon