 |
 | Home | Contact Us | FAQ | Search & Site Map | Link to Us |
 | Sign In | Join | Other 45 Sites in Network |
| HomeDiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWordDirectoryUser Groups Related Topics Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ... |
MS Office Forum / Word / Programming / November 2004Repeat Macro
Hello from Steved I have a document where I run the below macro At the moment I run the macro several times How do I have the macro below run without me having to execute it each time as sometimes I may have to run it up to 300 or more times in the same document. Simply put how do I get it to run again automatically to the end of the document please. Thankyou. Sub RaceDictionary() Selection.Find.ClearFormatting With Selection.Find .Text = "^$^$" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Selection.MoveLeft Unit:=wdCharacter, Count:=1 Selection.Extend Selection.HomeKey Unit:=wdLine Selection.Delete Unit:=wdCharacter, Count:=1 Selection.Find.ClearFormatting With Selection.Find .Text = "\(*by" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Selection.MoveLeft Unit:=wdCharacter, Count:=2, Extend:=wdExtend Selection.Delete Unit:=wdCharacter, Count:=1 Selection.TypeBackspace Selection.TypeText Text:="= " Selection.EndKey Unit:=wdLine Selection.TypeBackspace Selection.TypeText Text:=", " Selection.Find.ClearFormatting With Selection.Find .Text = "*$" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend Selection.Delete Unit:=wdCharacter, Count:=1 Selection.HomeKey Unit:=wdLine Selection.MoveDown Unit:=wdLine, Count:=1 Selection.TypeParagraph Selection.TypeParagraph Selection.MoveUp Unit:=wdLine, Count:=2 Selection.TypeText Text:="X" Selection.Extend Selection.HomeKey Unit:=wdLine Selection.Find.ClearFormatting Selection.Find.Font.Size = 30 With Selection.Find .Text = "" .Replacement.Text = "" .Forward = True .Wrap = wdFindAsk .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend Selection.Delete Unit:=wdCharacter, Count:=1 Selection.HomeKey Unit:=wdLine Selection.Delete Unit:=wdCharacter, Count:=1 Selection.Delete Unit:=wdCharacter, Count:=1 End Sub I haven't tried to work out what you want this macro to do, but if it's the same problem that you posted into the newusers newsgroup about converting 1. 7322x Prince Of Seville 7. 07x9x Symboli Rex 8. Lord Mellays Chief to Prince Of Seville Symboli Rex Lord Mellays Chief See the response in that newsgroup.  SignaturePlease respond to the Newsgroup for the benefit of others who may be interested. Questions sent directly to me will only be answered on a paid consulting basis. Hope this helps, Doug Robbins - Word MVP > Hello from Steved > [quoted text clipped - 99 lines] > Selection.Delete Unit:=wdCharacter, Count:=1 > End Sub Hello Doug from Steved Below is what my objective is. You macro gives me the Poker Face Using my macro below will give the below result, in other words I've been able to build it to do one at a time hence when i've got to press the macro button each time maybe up to 3 hundred times I thought about automating the process, this is where your macro comes in, as now your macro will do the lot but I would like to have it so that it will do the below when I push the macro button it does the whole lot in one session. If you have time to try my macro at the bottom you will see 3 under Innes make shore the font is 30 , by do that you will see what I'm try to acheive. Once again thankyou. Poker Face= by Super Gray, $750 2. 6384 Poker Face (17) 4g br Pentire (GB)-Gold Raider (G2P by Super Gray) Leith Innes(56) Stats: Trnr: John Sargent (Matamata) Ownr: W J Gleeson All 4:0:0:1:1 Prz $750 F 1:0:0 E 2:0:1 S 1:0:0 H 0:0:0 C 0:0:0 D 0:0:0 F90 1:0:0:0 F30 1:0:0:0 2Up 1:0:0:1 Fav 0:0:0:0 2 Fav 1:0:0:0 Win $0.00 Plc $0.48 Perf: TAUP 18 Aug 2004 - 6 of 11 Mdn $5K 1800 F- Hayden Tinsley 56 (9) 10/10 $22.95 1st: Stik To The Basics 1:51.99 3.9L WAIK 08 Sep 2004 21 dys 3 of 11 Mdn $5K 2100 E3.0 Leith Innes 56 (2) 3/4 $4.65 1st: Breeze Hill (IRE) 2:14.46 4L RBPH 22 Sep 2004 14 dys 8 of 10 Mdn $5K 2200 S3.6 Leith Innes 56 (8) 2/3 $4.70 1st: Dicktator 2:21.36 17.5L PROA 03 Nov 2004 42 dys 4 of 15 Mdn $5K 2100 E2.8 Leith Innes 56 (11) 9/8 $18.05 1st: Zalika 2:12.64 2.3L - 3 >-----Original Message----- >I haven't tried to work out what you want this macro to do, but if it's the [quoted text clipped - 120 lines] > >. Hello Doug form Steved I've now incorporated your macro into mine and I'm getting the below result, so we are getting there. 1. 8234x Dreamsize= by Nuage d'Or, $10,340 >-----Original Message----- >I haven't tried to work out what you want this macro to do, but if it's the [quoted text clipped - 120 lines] > >. Hello Doug from Steved Ok I've been working on your macro, and I've incorporated it in mine. What I can now do thanks to you is push the macro and it will go threw the whole document, which is what I always havwe wanted, but I getiing the below result. 1. 6328x Lyall Bay= by Kingdom Bay, $2,700 but need it to have the below result Lyall Bay= by Kingdom Bay, $2,700 Can you kindly please direct me thankyou. ps ignore the other replies. Sub RaceDictionary() Dim i As Long, j As Long, pararange As Range For i = 1 To ActiveDocument.Paragraphs.Count Set pararange = ActiveDocument.Paragraphs(i).Range For j = 1 To pararange.Characters.Count If Asc(pararange.Characters(j)) > 64 And Asc (pararange.Characters(j)) < 91 Then pararange.End = pararange.Start + j - 1 pararange.Delete Exit For End If With Selection.Find .Text = "\(*by" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Selection.MoveLeft Unit:=wdCharacter, Count:=2, Extend:=wdExtend Selection.Delete Unit:=wdCharacter, Count:=1 Selection.TypeBackspace Selection.TypeText Text:="= " Selection.EndKey Unit:=wdLine Selection.TypeBackspace Selection.TypeText Text:=", " Selection.Find.ClearFormatting With Selection.Find .Text = "*$" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend Selection.Delete Unit:=wdCharacter, Count:=1 Selection.HomeKey Unit:=wdLine Selection.MoveDown Unit:=wdLine, Count:=1 Selection.TypeParagraph Selection.TypeParagraph Selection.MoveUp Unit:=wdLine, Count:=2 Selection.TypeText Text:="X" Selection.Extend Selection.HomeKey Unit:=wdLine Selection.Find.ClearFormatting Selection.Find.Font.Size = 30 With Selection.Find .Text = "" .Replacement.Text = "" .Forward = True .Wrap = wdFindAsk .Format = True .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend Selection.Delete Unit:=wdCharacter, Count:=1 Selection.HomeKey Unit:=wdLine Selection.Delete Unit:=wdCharacter, Count:=1 Selection.Delete Unit:=wdCharacter, Count:=1 Next j Next i End Sub >-----Original Message----- >I haven't tried to work out what you want this macro to do, but if it's the [quoted text clipped - 120 lines] > >.
|
Reply to this Message |
 Sign In
 Join
 My Latest Posts My Monitored Threads My Blog My Photo Gallery My Profile My Homepage Start New Thread Enable EMail Alerts Rate this Thread
|
©2008 Advenet LLC Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.