
Loop search, do something, stop at end
I'm not a
VBA programmer and although I have written a few macros
ocassionally, I usually struggle. I am now working to automate text
formating of 200 documents which will be imported into quark express
as tag files. I did this once before under wordperfect and now I need
to do the same for word.
I have come accross the same problem as I did under wordperfect and I
don't wish to use the inelegant solution I did then. The problem
appears to be a common one and I have found many threads about the
same thing - namely 'how to find somnething, change something
associated with it and repeat the process until the end of the
document'
I have tried many of the multitude of suggestions offered but I just
can't make them work. There seems to be one prefered method - execute
the search funtion with a while loop until search fails.
eg.
With Selection.Find
' other find parameters, including the text to find
Do While .Execute ' that is, while search is succesful
' insert the code to do here when the search is successful
Loop
End With
But it doesn't work for me... perhaps because I change the selection
during the act which I need to perform?
Anyway, this is what I need to do. My macro has already identified
main headings and given them the correct tag by searching for all
double line breaks (^p^p) and replacing/appending them with the
approbriate code. Now I need to find sub headings which can be
identified by virtue of have a single line break before them and have
no full stop at the end of them (unlike a sentence which would have).
Here is an example piece of text.
Main heading
Sub heading
Some text blaa blaa blaa. Another sentance blaa blaa blaa.
Sub heading
More text blaa blaa blaa. And yet more.
Main heading
Sub heading
Some text blaa blaa blaa. Another sentance blaa blaa blaa.
Sub heading
More text blaa blaa blaa. And yet more.
So my search loop aims to find paragraph breaks and check that it is a
lone paragraph break and is not preceded by a fullstop then go to the
start of the line and insert the require tag.
Below is the code I have tried ...
Sub sub_headers()
Selection.HomeKey Unit:=wdStory
Selection.find.ClearFormatting
With Selection.find
Do While .Execute(FindText:="^p", Wrap:=wdFindContinue, Forward:=True)
= True
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Selection.MoveRight Unit:=wdCharacter, Count:=3, Extend:=wdExtend
strTemp = Selection.Text
If (Left(strTemp, 1) <> "." And Right(strTemp, 1) <> "^p" And
Selection.HomeKey Unit:=wdLine
Selection.EndKey Unit:=wdLine
Selection.MoveRight Unit:=wdCharacter, Count:=1
End If
Loop
End With
End Sub
The result is an endless loop that never makes it through the document
but stays near the top. I have taken a backward step here because
until I tried to incorporate the methods suggested in the newsgroups,
I had at least got my code doing everything I wanted except for
stopping at the end. ;-)
Ben