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!

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

How to make recorded macros in Word loop 2

Status
Not open for further replies.

HowdeeDoodee

Technical User
Mar 14, 2005
61
US
I want to make the following MS Word macros loop and stop at either the top of the file or the bottom of the file. Thank you in advance for your replies.

-----------------------------------
Macro 1
'
'This macro does not stop when the bottom of file is reached. I want this macro to stop executing when the bottom of the file is reached.



Selection.Find.ClearFormatting
With Selection.Find
.Text = vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab _
& vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
With Selection.Font
.Name = ""
.Bold = False
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Spacing = 0
.Scaling = 100
.Position = 0
.Kerning = 0
.Animation = wdAnimationNone
End With
Selection.MoveRight Unit:=wdCharacter, Count:=1

---------------------------
Macro 2


'
'
'This macro does not stop at the top of the file when TOF is reached. I want this macro to stop executing when the top of the file is reached. This macro runs from the botttom of the document.



Selection.Find.ClearFormatting
Do While Not TOF
Selection.Find.Font.Bold = True
With Selection.Find
.Text = "*"
.Replacement.Text = ""
.Forward = False
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:=vbTab & vbTab
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText Text:=vbTab & vbTab
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Loop
 
Macro1.

This is what I think you want:

Code:
[blue]    Selection.Find.ClearFormatting
    [red]Selection.Find.Replacement.ClearFormatting[/red]
    With Selection[red].Find.Replacement[/red].Font
        .Name = ""
        .Bold = False
        .Italic = False
        .Underline = wdUnderlineNone
        .UnderlineColor = wdColorAutomatic
        .StrikeThrough = False
        .DoubleStrikeThrough = False
        .Outline = False
        .Emboss = False
        .Shadow = False
        .Hidden = False
        .SmallCaps = False
        .AllCaps = False
        .Color = wdColorAutomatic
        .Engrave = False
        .Superscript = False
        .Subscript = False
        .Spacing = 0
        .Scaling = 100
        .Position = 0
        .Kerning = 0
        .Animation = wdAnimationNone
    End With
    With Selection.Find
        .Text = vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab _
             & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab & vbTab[red] & "*^13"[/red]
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = [red]True[/red]
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = [red]True[/red]
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute [red]Replace:=wdReplaceAll[/red][/blue]
But I suspect you don't really need to apply all that formatting and I can't imagine what you're doing with 16 consecutive tabs.

Macro2.

This could be better done but these changes will make it do as you ask:

Code:
[blue]Selection.Find.ClearFormatting
Do [green]' While Not TOF[/green]
    Selection.Find.Font.Bold = True
    With Selection.Find
        .Text = "*"
        .Replacement.Text = ""
        .Forward = False
        .Wrap = wdFind[red]Stop[/red]
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    [red]If Not[/red] Selection.Find.Execute [red]Then Exit Do[/red]
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:=vbTab & vbTab
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.MoveUp Unit:=wdParagraph, Count:=1, Extend:=wdExtend
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:=vbTab & vbTab
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
Loop[/blue]

Enjoy,
Tony

------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

I'm working (slowly) on my own website
 
Thank you for the suggestions. Both work fine. I am doing document conversions going from non-Word format, to Word format, to Excel, to MySql. This is why one "cannot imagine" why I am doing what I am doing. :)

Thank you again for the help
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top