End of Document found in a macro

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I am writing a macro to search a document for cetain text and every time it finds it, insert a section break before. I can't find a way to stop this macro automatically. Is there a way to capture the end of document has been found so I can exit my do loop?
 
The replace function is probably the fastest way to do this. The following
will insert a continuous section break before the text entered in the input
box. You can change the type of section break easily enough.

Sub SectBreak()
sText = InputBox("Enter exact text to be found", "Insert Section Break",
"")
Selection.HomeKey Unit:=wdStory
Selection.InsertBreak Type:=wdSectionBreakContinuous
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Cut
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = sText
.Replacement.Text = "^c" & sText
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><
Graham Mayor - Word MVP

My web site www.gmayor.com
Word MVP web site www.mvps.org/word
<>>< ><<> ><<> <>>< ><<> <>>< <>><
 
Oops - I missed out a line :(

Sub SectBreak()
sText = InputBox("Enter exact text to be found", "Insert Section Break",
"")
Selection.HomeKey Unit:=wdStory
ActiveWindow.ActivePane.View.ShowAll = True
Selection.InsertBreak Type:=wdSectionBreakContinuous
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Cut
ActiveWindow.ActivePane.View.ShowAll = False
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = sText
.Replacement.Text = "^c" & sText
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><
Graham Mayor - Word MVP

My web site www.gmayor.com
Word MVP web site www.mvps.org/word
<>>< ><<> ><<> <>>< ><<> <>>< <>><
 
Try putting an E-N-D statement in the code after the Insert section break statement that you use.(Not the End sub statement)
 
Thanks. Follow on question, the text I am searching for looks like this "SECTION n." where "n" is a number. Is there a way to replace a selection that could be variable since the number could be 1, 2 or 3 positions long? Also, in the replacement string, I want to replace the text with SECTION {SECTION} so the section numbers are auto-numbered. Is it easiest to use the clipboard like you used before? But gettnig the variable length text is my bigger challenge.
 
I will be out most of tomorrow but if you want to post me an example via the
link on my web site, I'll have a look. It is probably just a matter of
changing to a wildcard search pattern. If you are keen to investigate for
yourself in the meantime - see
http://word.mvps.org/FAQs/General/UsingWildcards.htm


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><
Graham Mayor - Word MVP

My web site www.gmayor.com
Word MVP web site www.mvps.org/word
<>>< ><<> ><<> <>>< ><<> <>>< <>><
 
Will this work wince I am basically looping through finding every instance. What I really need is a means to trap that I've reached the end of the document and exit the loop then. I've been given a different solution using the replace function that is getting me 75% of the way there. If you know how to trap that the message occurred, let me know

Thanks
 
Thanks. I review your attachment and see what I can come up with. I'm not sure that's going to address the issue of having the Section Autonumbering field added in as well. But I'll play with it and see what I get. Any thoughts on that would be great. Thanks again for your help.
 
Given that you are looking for "Section n" that can easily be found using
wildcards.
The replacement including the section field can be replaced using the method
in the macro. The revised code which includes the means to update the
section numbers is as follows. As replace works much faster than looping the
change is almost instantaneous. Note I have used a continuous section break
and the macro pre-supposes that the document begins with Section1. It should
not be too difficult to adapt this to suit your exact requirements,

Sub SectBreak()
'Define search text
sText = "Section [0-9]{1,}"

Selection.HomeKey Unit:=wdStory
ActiveWindow.ActivePane.View.ShowAll = True
Selection.InsertBreak Type:=wdSectionBreakContinuous
Selection.TypeText Text:="Section "
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.TypeText Text:="Section"
Selection.MoveRight Unit:=wdCharacter, Count:=2
Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Cut
ActiveWindow.ActivePane.View.ShowAll = False
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = sText
.Replacement.Text = "^c"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

'Clean up the unwanted section break at the start.
Selection.Delete Unit:=wdCharacter, Count:=1

'Update the fields
Options.UpdateFieldsAtPrint = True
Application.ScreenUpdating = False
PrintPreview = True
PrintPreview = False
ActiveDocument.ActiveWindow.View.Type = wdPrintView
Application.ScreenUpdating = True
End Sub


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><
Graham Mayor - Word MVP

My web site www.gmayor.com
Word MVP web site www.mvps.org/word
<>>< ><<> ><<> <>>< ><<> <>>< <>><
 
Your version doesn't work for me. From what I can see the only intentional
differences are upper case for Section and the selection of a font (which I
would have effected with a paragraph style). So try -

Sub SectBreak()
sText = "SECTION [0-9]{1,}"
Selection.HomeKey Unit:=wdStory
ActiveWindow.ActivePane.View.ShowAll = True
Selection.InsertBreak Type:=wdSectionBreakContinuous
Selection.TypeText Text:="SECTION "
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.TypeText Text:="SECTION"
Selection.MoveRight Unit:=wdCharacter, Count:=2
Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Cut
ActiveWindow.ActivePane.View.ShowAll = False
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = sText
.Replacement.Text = "^c"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

'Clean up the unwanted section break at the start.
Selection.Delete Unit:=wdCharacter, Count:=1

'Update the fields
Options.UpdateFieldsAtPrint = True
Application.ScreenUpdating = False
PrintPreview = True
PrintPreview = False
ActiveDocument.ActiveWindow.View.Type = wdPrintView
Application.ScreenUpdating = True
Selection.WholeStory
Selection.Font.Name = "Times New Roman"
Selection.HomeKey Unit:=wdStory

End Sub

I've got the following working except for 1 thing, for each
continuous break that I am adding, the previous break gets changed to
a new page break. I duplicated this manually using the Replace Next
option. At he end, the only break that is continuous is the last
one. Any thoughts?

Thanks

Steve

Sub SectBreak()

'Define search text
sText = "SECTION [0-9]{1,}"

Selection.EndKey Unit:=wdStory
ActiveWindow.ActivePane.View.ShowAll = True
ActiveWindow.ActivePane.View.ShowFieldCodes = True

'Insert Contents to be Cut into the clipboard
Selection.InsertBreak Type:=wdSectionBreakContinuous
Selection.TypeText Text:="SECTION "
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.TypeText Text:="SECTION \* MERGEFORMAT "
Selection.MoveRight Unit:=wdCharacter, Count:=2
Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Cut
'Set up the Replace All with the clipboard
ActiveWindow.ActivePane.View.ShowAll = False
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = sText
.Replacement.Text = "^c"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = True
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

' Reset the Font
Selection.WholeStory
Selection.Fields.Update
Selection.Font.Name = "Times New Roman"

ActiveWindow.ActivePane.View.ShowFieldCodes = False

' Delete the first Section Break
Selection.HomeKey Unit:=wdStory
Selection.Delete Unit:=wdCharacter, Count:=1

' Update the field codes to get the right section numbers
Selection.WholeStory
Selection.Fields.Update
Selection.HomeKey Unit:=wdStory

End Sub
Click to expand...
 
Back
Top