PDA

View Full Version : Run macro only on selected text



island17
02-27-2006, 10:17 AM
I suppose this is an easy one, but I need some help to get me started. I have a macro that works well, but now my users asked if we can run it only on the text that they select with the mouse. My macro does some formatting, and find and replace.

Thanks

mdmackillop
02-27-2006, 10:42 AM
Use Selection within the code to operate only on selected text. eg

With Selection.Font
.Bold = True
.Italic = True
End With

island17
02-27-2006, 11:09 AM
I tried this method and it still applies the macro to the entire document,and not just the area I selected with the mouse. Do I need to set a range for this to work?

mdmackillop
02-27-2006, 11:22 AM
Can you post your macro?

island17
02-27-2006, 12:46 PM
I was going to give you just a snipet, but dicided to post the whole thing. By the way I copied and paste the macro, how else could I have post it.

Type MeasNwieghts
mAbbr As String
mExpd As String
End Type
Type FraksConver
FrNum As String
supCode As Integer
End Type

Sub Recipe()
'rgm 022506
'This macro will format recipe files
Dim defFont As String
Dim defHed As String
Dim defIngr As String
Dim Fraks(9) As FraksConver
Dim Meas(8) As MeasNwieghts
Dim p As Paragraph

defFont = "FE Recipe body"
defHed = "FE Recipe title"
defIngr = "FE Recipe ingredients"

Fraks(0).FrNum = "1/2"
Fraks(0).supCode = "189"
Fraks(1).FrNum = "3/8"
Fraks(1).supCode = "229"
Fraks(2).FrNum = "1/4"
Fraks(2).supCode = "188"
Fraks(3).FrNum = "3/4"
Fraks(3).supCode = "190"
Fraks(4).FrNum = "2/3"
Fraks(4).supCode = "170"
Fraks(5).FrNum = "1/3"
Fraks(5).supCode = "146"
Fraks(6).FrNum = "5/8"
Fraks(6).supCode = "240"
Fraks(7).FrNum = "7/8"
Fraks(7).supCode = "248"
Fraks(8).FrNum = "1/8"
Fraks(8).supCode = "222"

Meas(0).mAbbr = "oz."
Meas(0).mExpd = "ounce"
Meas(1).mAbbr = "ozs."
Meas(1).mExpd = "ounces"
Meas(2).mAbbr = "lb."
Meas(2).mExpd = "pound"
Meas(3).mAbbr = "lbs."
Meas(3).mExpd = "pounds"
Meas(4).mAbbr = "tsp"
Meas(4).mExpd = "teaspoon"
Meas(5).mAbbr = "tbsp."
Meas(5).mExpd = "tablespoon"
Meas(6).mAbbr = " g "
Meas(6).mExpd = " grams "
Meas(7).mAbbr = "mg"
Meas(7).mExpd = "milligrams"
Selection.HomeKey wdStory
ActiveDocument.Select
Selection.Style = defFont

StyleBullets ' procedure to style text after sqaure bulltes

' convert fractions to super script
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "[1-7]/[2-8]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
End With

Do While Selection.Find.Execute = True
For i = 0 To 8
If Selection.Text = Fraks(i).FrNum Then
Selection.TypeText Chr(Fraks(i).supCode)
End If
Next i
Loop

'convert measures
For i = 0 To 7
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = Meas(i).mAbbr
.Replacement.Text = Meas(i).mExpd
.Forward = True
.Wrap = wdFindContinue
.MatchAllWordForms = False
.MatchCase = False
.MatchWildcards = False
End With
Do While Selection.Find.Execute = True
Selection.Find.Execute Replace:=wdReplaceAll
Loop
Next i

'find and bold
FindNbold Procedure to bold certain words

For Each p In ActiveDocument.Paragraphs
p.Range.Select
If InStr(1, p.Range, Chr(228)) > 0 Then
stpo = InStr(1, p.Range, Chr(228)) + 1
Selection.Collapse wdCollapseStart
Selection.MoveStart stpo
Selection.MoveEndUntil cset:=vbCr
Selection.Style = defHed
End If
Next p





End Sub


Sub StyleBullets()
defHed = "FE Recipe title"
'
For Each p In ActiveDocument.Paragraphs
p.Range.Select
If InStr(1, p.Range, Chr(228)) > 0 Then
Selection.Style = defHed
End If
Next p

End Sub


Sub FindNbold()
Options.MatchFuzzyCase = True
Selection.HomeKey wdStory
Selection.Find.ClearFormatting

With Selection.Find
.Text = "Yield:"
.Replacement.Font.Bold = True

.Forward = True
.Wrap = wdFindContinue
.MatchAllWordForms = False
.MatchCase = False
.MatchWholeWord = False
End With
Do While Selection.Find.Execute = True
Selection.Font.Bold = True
Loop


Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Yields:"
.Replacement.Font.Bold = True

.Forward = True
.Wrap = wdFindContinue
.MatchAllWordForms = False
.MatchCase = False
.MatchWholeWord = False
End With
Do While Selection.Find.Execute = True
Selection.Font.Bold = True
Loop


Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Servings:"
.Replacement.Font.Bold = True

.Forward = True
.Wrap = wdFindContinue
.MatchAllWordForms = False
.MatchCase = False
.MatchWholeWord = False
End With
Do While Selection.Find.Execute = True
Selection.Font.Bold = True
Loop


Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Per serving:"
.Replacement.Text = ""

.Forward = True
.Wrap = wdFindContinue
.MatchAllWordForms = False
.MatchCase = False
.MatchWholeWord = False
End With

Do While Selection.Find.Execute = True
Selection.Font.Bold = True
Loop




Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Diet exchanges:"
.Replacement.Font.Bold = True

.Forward = True
.Wrap = wdFindContinue
.MatchAllWordForms = False
.MatchCase = False
.MatchWholeWord = False
End With
Do While Selection.Find.Execute = True
Selection.Font.Bold = True
Loop


Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Source:"
.Replacement.Font.Bold = True

.Forward = True
.Wrap = wdFindContinue
.MatchAllWordForms = False
.MatchCase = False
.MatchWholeWord = False
End With

Do While Selection.Find.Execute = True
Selection.Font.Bold = True
Loop


End Sub

mdmackillop
02-27-2006, 01:08 PM
Hi Russ,
Posting that way is OK, or you could attach a file containing your code, with sample text.
Selection.HomeKey wdStory returns you to the beginning of the document. It looks as though a Range will be required to restrict the macro to your chosen selection. Which subs are you looking to run?
Regards
MD

island17
02-27-2006, 01:12 PM
All of it.

mdmackillop
02-27-2006, 01:14 PM
Can you post a small sample of your text?

island17
02-27-2006, 01:25 PM
Here is the sample I am working with. The junk at the top of the page is to be left as is. We want to be able to select the recipe portion and run the macro on it. The top portion will vary in length and may contain fractions and words that the macro would identify if we didn't manually select the bottom portion. I hope I didn't confuse things.

Some junk, more junk.
Some junk, more junk.
Some junk, more junk.
Some junk, more junk.
Some junk, more junk.
Some junk, more junk.
Some junk, more junk.
Some junk, more junk.
Some junk, more junk.
Some junk, more junk.
Some junk, more junk.
Some junk, more junk.
Some junk, more junk.
FOODSTYLES

ROAST VEGETABLE COMPOTE
1 large orange bell pepper
1 small red onion
1 medium tangerine
1 tablespoon olive oil
1/4 teaspoon salt
1/4 teaspoon pepper
1/16 teaspoon cayenne pepper, optional
1/4 teaspoon sugar

Core pepper and cut into thin strips. Cut onion into thin slices, then cut into semicircles. Place vegetables in a bowl. Add 1 tablespoon tangerine juice, reserving remainder of the tangerine. Add olive oil, salt, pepper and cayenne pepper, if desired.
Spread vegetable mixture on a baking sheet. Bake in preheated 375-degree oven for 15 to 20 minutes, or until vegetables are very tender. Stir halfway through baking. Remove from oven. Spoon vegetables and any cooking juices into a serving bowl. Add 2 tablespoons tangerine juice and sugar and stir well. Set aside 10 minutes for flavors to blend. Serves 2.

mdmackillop
02-28-2006, 01:10 AM
Trickier than I thought. Here's the simple solution. Call your sub from the following macro

Sub DoFormat()
Application.ScreenUpdating = False
Selection.Cut
Documents.Add DocumentType:=wdNewBlankDocument
Selection.PasteAndFormat (wdPasteDefault)
Selection.HomeKey Unit:=wdStory
Recipe
Selection.WholeStory
Selection.Cut
ActiveWindow.Close False
Selection.PasteSpecial Link:=False, DataType:=wdPasteOLEObject, Placement _
:=wdInLine, DisplayAsIcon:=False
Application.ScreenUpdating = True
End Sub

island17
02-28-2006, 10:31 AM
This works perfectly. The funny thing is that around 4:00 this morning I came up with the same idea, but didn?t have time to work it out. The sad thing is that I am dreaming about macros and not sailing in the Virgin Islands like everyone else. So as soon as I finish this macro I think I should pick up some travel brochures. It must be time for a vacation.

Thanks again for your help.

mdmackillop
02-28-2006, 11:30 AM
I must agree about the vacation. It occurred to me about 7am