Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Shaun E on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Can't stop the loop 2

Status
Not open for further replies.
MarcusStringer

MarcusStringer

IS-IT--Management
Sep 11, 2003
1,407
AU
I've neally got it...but
this is what I'm trying to do
I have a word file which has 200 odd footnotes.
I have to change the footnote numbers to<FootnoteNumber>
 [[FR <FootnoteNumber>]]

So it reads 1 [[FR 1]], 2 [[FR 2]] etc all the way to 200.
I can get most of it through doing a find for ^f and replacing with ^&[[FR ^&]],
but the second ^& becomes footnote 2 instead of one.

So I was thinking about just doing a find for ^f and replacing it with ^& [[FR 1]], and somehow have that 1 count on so when it hits the next footnote it will be 2, and so on (like an autonumber).
What I can't do is stop the loop when it gets to the end.

Please help..


Sub Macro2()
'
' Macro2 Macro
' Macro recorded 21/10/04 by Marcus Stringer
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p"
.Replacement.Text = "[[E ]]^p "
.Forward = True
.Wrap = wdFindContinue
.AllDocuments = True
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^f"
.Replacement.Text = "^&[[FR ]]"
.Forward = True
.Wrap = wdFindContinue
.AllDocuments = True
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
With Selection.Find.Font
.Size = 10
.Superscript = True
.Subscript = False
End With
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Size = 10
.Superscript = True
.Subscript = False
End With
With Selection.Find
.Text = "^f"
.Replacement.Text = "^& [[FR ]]"
.Forward = True
.Wrap = wdFindContinue
.AllDocuments = True
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With


Selection.Find.ClearFormatting
With Selection.Find.Font
.Size = 10
.Superscript = True
.Subscript = False
End With
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Size = 10
.Superscript = True
.Subscript = False
End With
With Selection.Find
.Text = "FR"
.Replacement.Text = "F"
.Forward = True
.Wrap = wdFindContinue
.AllDocuments = True
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

With Selection.Find
.Text = "]]"
.Replacement.Text = "^&[[FR ]]"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With

Do
With Selection.Find
.Text = "]]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText Text:=""
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"SEQ OLE_LINK1 \n ", PreserveFormatting:=True
Selection.MoveRight Unit:=wdCharacter, Count:=2
Loop
 
Sort by date Sort by votes
Hi Marcus,

I haven't studied your code but two things should help.

1. Change .Wrap = wdFindContinue
To .Wrap = wdFindStop

to make the Find stop at the end of the document - and make sure you are starting at the top to begin with (if you aren't already)

2. The Find.Execute method returns True or False so can be used as loop control, or after the execute the Find.Found property is either True or False and can be similarly used.

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.
Excel VBA Training and more Help at [url=http://www.vbaexpress.
 
Upvote 0 Downvote
Hi Tony,

Have tried your suggestion...doesn't work.

As you can tell...very new to all this...so can't understand why it doesn't work.
I can get it to do everything except stop at the end of the document. (in the loop bit).
It gets to the end and keeps puting numbers after each other until I force it to stop (command+.).
If I take the loop bit out of the macro then it will work (apart from doing what's in the loop of course)...

Below is what I've got so far.

Sub Macro2()
'
' Macro2 Macro
' Macro recorded 21/10/04 by Marcus Stringer
'
With Selection.Find
Selection.Find.ClearFormatting
With Selection.Find.Font
.Superscript = True
.Subscript = False
End With
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Superscript = True
.Subscript = False
End With
.Text = "^f"
.Replacement.Text = "^&[[FR ]]"
.Forward = True
.Wrap = wdFindStop
.AllDocuments = True
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll


With Selection.Find
Selection.Find.ClearFormatting
With Selection.Find.Font
.Size = 10
.Superscript = True
.Subscript = False
End With
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Size = 10
.Superscript = True
.Subscript = False
End With
With Selection.Find
.Text = "[[FR ]]"
.Replacement.Text = "[[F ]]"
.Forward = True
.Wrap = wdFindStop
.AllDocuments = True
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
End With
Selection.Find.Execute Replace:=wdReplaceAll

Do
With Selection.Find
Selection.Find.ClearFormatting
With Selection.Find.Font
.Size = 12
.Superscript = True
.Subscript = False
End With
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Size = 12
.Superscript = True
.Subscript = False
End With
.Text = "[[FR ]]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Selection.TypeText Text:=""
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"SEQ OLE_LINK1 \n ", PreserveFormatting:=True
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Loop

End Sub


Marcus
 
Upvote 0 Downvote
Seems your last Do ... Loop has NO exit

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244
 
Upvote 0 Downvote
sorry...but where does the exit go???
I've got documentation saying stuff like
do
loop until...
Does the exit go before the loop (but then how does it know to loop?)
or does it go after the loop (and then how does it know to exit the loop?)

Aaaarggghh!!!!!

Marcus
 
Upvote 0 Downvote
Hi Marcus,

Let's tryand tidy your code up a bit for you.

The Selection.Find object is static. Once you set the various properties they won't change until you change them so you can set them once at the start and forget them which clears a lot of clutter out of the rest of the code. So if we split your first Find into two parts, the parameters you are not going to change and those you are, then we can remove the (re-)setting of the ones you are not going to change from the later finds (I have also tidied up a couple of your With blocks here - removing redundant ones and removing excess qualification from others and lastly removing a couple which became redundant) ..

Code: 
[blue]Sub Macro2()
'
' Macro2 Macro
' Macro recorded 21/10/04 by Marcus Stringer
'

[green]' The 'fixed' bits[/green]
    With Selection.Find
        .ClearFormatting
        With .Font
            .Superscript = True
            .Subscript = False
        End With
        .Replacement.ClearFormatting
        With .Replacement.Font
            .Superscript = True
            .Subscript = False
        End With
        .Forward = True
        .Wrap = wdFindStop
        .AllDocuments = True
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
        
[green]' The 'variable' bits[/green]
    With Selection.Find
        .Text = "^f"
        .Replacement.Text = "^&[[FR ]]"
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
[green]' Just the variable bits this time[/green]
    With Selection.Find
        .Font.Size = 10
        .Replacement.Font.Size = 10
        .Text = "[[FR ]]"
        .Replacement.Text = "[[F ]]"
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

Do
    With Selection.Find
        .Font.Size = 12
        .Replacement.Font.Size = 12
        .Text = "[[FR ]]"
        .Replacement.Text = ""
        .Format = False
    End With
 
    Selection.Find.Execute
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.TypeText Text:=""
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
    "SEQ OLE_Link1 \n ", PreserveFormatting:=True
    Selection.MoveLeft Unit:=wdCharacter, Count:=2

Loop

End Sub[/blue]

Now that we can see what is going on a bit better, you do a global change of all footnote references to append the "[[FR ]]" text. Note that this change will run from the cursor to the end of the document (because of Forward=True and Wrap=Stop) so you should be at the top of the document to start with - so add Selection.Homekey wdstory at the start of the code.

Then you do an odd change of font size 10 [[FR ]]'s - I don't know what you're trying to achieve with that so I'll leave it.

Then your loop - the replacement text and font are pointless as you don't replace anything - the font size 12 is pointless as you set format to false. Also the moveleft at the end of the loop achieves nothing. Next, once you have set up the find, you don't want to do it every time through the loop so take it outside. this leaves, for your loop at the end ..

Code: 
[blue]    With Selection.Find
        .Text = "[[FR ]]"
        .Format = False
    End With
 
Do
    Selection.Find.Execute
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.TypeText Text:=""
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
    "SEQ OLE_Link1 \n ", PreserveFormatting:=True

Loop[/blue]

Now, your loop control. You want to loop until Find.Execute returns False (i.e. not found) so you can use that as your loop control but note that when you do so, the Find will be executed so is not needed inside the loop as well ..

Code: 
[blue]Do Until Selection.Find.Execute = False
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.TypeText Text:=""
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
    "SEQ OLE_Link1 \n ", PreserveFormatting:=True

Loop[/blue]

Finally, I fear this may have souded a bit critical - my apologies if that's the case. I'm not sure this will do exactly what you want but hopefuly will get you going again. If you have any more problems or questions, please come back.

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.
Excel VBA Training and more Help at [url=http://www.vbaexpress.
 
Upvote 0 Downvote
HI Tony,
don't be scared to sound critical, as I said, I know nothing, I'm just greatful all you people are helping me.

OK, I fixed up the code (which makes a lot more sense now)
The "odd change of font size to 10" is because I have to change the footnotes to look like 1[[F 1]]. But the footnote references throughout the text have to look like 1[[FR 1]]. The actual footnote is at 10pt whereas the footnote reference is 12pt.

But the main problem I'm having now is the loop only does every second footnote reference.
1[[FR ]]
2[[FR 1]]
3[[FR ]]
4[[FR 2]] instead of
1[[FR 1]]
2[[FR 2]] etc.

and when it gets to the end and I view>footnotes, they also havn't changed to
1[[F ]] which they used to do.

I think the loop has something do do with it


Marcus
 
Upvote 0 Downvote
Hi Marcus,

We're on opposite sides of the world and I'm off ot bed now so can't give ths the time it needs till the morning.

When I run it, it does all the references in the document but not the footnotes. Without testing I'm not sure of the best way to do them (footnotes are in what word calls a different storyrange and addressing that is probably the way to go).

Don't understand why it does alternate ones only for you but will see if I can think of anything - it might be worth reinstating the moveleft at the end of the loop to see if that makes a difference. Another possibility I can't test is the effect of the Find.Alldocuments (as I have 2k and it was new in xp).

I will post back tomorrow when I have had a chance to look properly

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.
Excel VBA Training and more Help at [url=http://www.vbaexpress.
 
Upvote 0 Downvote
Hi Tony
Happy Happy days.
It works alright except I have to click in the footnote section and run the macro then click in the body text section and run the macro again to apply the footnote reference bit.

Is there a way to be able link both these bits, so the macro only runs once?

I've pretty much used a combo of yours and mine otherwise it wouldn't work

Sub Marcus()
'
' Marcus Macro
' Macro created 27/10/04 by Marcus Stringer with alot of help from TonyJollans
'

Selection.HomeKey wdStory

With Selection.Find
Selection.Find.ClearFormatting
With Selection.Find.Font
.Size = 12
.Superscript = True
.Subscript = False
End With
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Size = 12
.Superscript = True
.Subscript = False
End With
.Text = "^f"
.Replacement.Text = "^&[[FR ]]"
.Forward = True
.Wrap = wdFindStop
.AllDocuments = True
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll



If Selection.Find.Execute Then
Do While Selection.Find.Execute = True
With Selection.Find
.Text = "[[FR ]]"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.MoveRight unit:=wdCharacter, Count:=1
Selection.MoveLeft unit:=wdCharacter, Count:=2
Selection.TypeText Text:=""
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"SEQ OLE_LINK1 \n ", PreserveFormatting:=True
Selection.MoveRight unit:=wdCharacter, Count:=2
Loop
Else
End If

With Selection.Find
Selection.Find.ClearFormatting
With Selection.Find.Font
.Size = 10
.Superscript = True
.Subscript = False
End With
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Size = 10
.Superscript = True
.Subscript = False
End With
With Selection.Find
.Text = "^f"
.Replacement.Text = "[[F ]]^&"
.Forward = True
.Wrap = wdFindStop
.AllDocuments = True
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
End With
Selection.Find.Execute Replace:=wdReplaceAll

'If Selection.Find.Execute Then
' Do Until Selection.Find.Execute = True
' With Selection.Find
' .Text = "[[F ]]"
' .Forward = True
' .Wrap = wdFindStop
' .Format = False
' .MatchCase = False
' .MatchWholeWord = False
' .MatchWildcards = False
' .MatchSoundsLike = False
' .MatchAllWordForms = False
' End With
' Selection.Find.Execute
' Selection.MoveRight unit:=wdCharacter, Count:=1
' Selection.MoveLeft unit:=wdCharacter, Count:=2
' Selection.TypeText Text:=""
' Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
' "SEQ OLE_LINK1 \n ", PreserveFormatting:=True
' Selection.MoveRight unit:=wdCharacter, Count:=2
'Loop
'Else
'End If



End Sub


Marcus
 
Upvote 0 Downvote
Hi Tony,
It all works now.... all I have left to do is put some numbers in the footnotes.
[[F 1]]1
[[F 2]]2 etc
at the moment it is only [[F ]]1, [[F ]]2 etc.
The Sequential number thing which worked in the text part doesn't work in the footnote part so I'm think about using a for...next loop.

For N=1 to 1000000
N+1
Next

and before that, have it search for "[[F ]]" and replace it with "[[F 1]]"
so that everytime it finds "[[F 1]]" then it will add 1, so 1 becomes 2 etc.


Do you think that will work (it's the end of the day, so I'm off home).
Just wanted to know if I'm on the right track before I spend all day tomorrow on it.


Marcus
 
Upvote 0 Downvote
Hi Marcus,

I'm quite sure your problems with this can be sorted out (and all the stuff with font sizes dealt with properly) but it's been bothering me and so I went back to the drawing board and I think I have a better solution.

Would you care to try this instead ..

Code: 
[blue]Sub ANewApproach()

Dim iFootNoteNum    As Integer
Dim objFootNote     As Footnote
Dim lFootNotePos    As Long
Dim strFootNoteText As String

For iFootNoteNum = ActiveDocument.Footnotes.Count To 1 Step -1

    Set objFootNote = ActiveDocument.Footnotes(iFootNoteNum)

    strFootNoteText = objFootNote.Range.Text
    
    objFootNote.Reference.Select
    lFootNotePos = Selection.Range.Start
    
    objFootNote.Delete
    
    Set objFootNote = ActiveDocument.Footnotes.Add( _
        Range:=ActiveDocument.Range(lFootNotePos, lFootNotePos), _
        Reference:=iFootNoteNum & "[[FR " & iFootNoteNum & "]]")
    objFootNote.Range.Text = strFootNoteText
    
Next

End Sub[/blue]

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.
Excel VBA Training and more Help at [url=http://www.vbaexpress.
 
Upvote 0 Downvote
Hi Tony,
Your blood should be bottled.
it worked like a charm.
thanks for all you help and patience.

one last question? I've posted this as a seperate question, but I thought I'd stretch my luck.

If i have a text field with the number 1, How can I make it add 1 then display the result? eg
This number is 1
This number is 2
This number is 3 etc etc.

Marcus
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

remeng
  • Locked
  • Solved
Run-time error '429': ActiveX component can't create object From Excel to Word
Replies
9
Views
2K
remeng
remeng
sxschech
  • Locked
  • Question
For Each Loop works once then gives error 91 2
Replies
19
Views
1K
sxschech
sxschech
morechocolate
  • Locked
  • Question
run-tune error 3704 operation is not allowed when the object is codes: I don't think so.
Replies
7
Views
2K
morechocolate
morechocolate
TenDollarTypo
  • Locked
  • Question
Merge every 9 Cells Loop
Replies
3
Views
428
TenDollarTypo
TenDollarTypo
huiettcm
  • Locked
  • Question
Catching the Mouse Click Error in Modal User Form
Replies
1
Views
673
strongm
strongm

Part and Inventory Search

Sponsor

Back
Top