I'm working on a Word 2007 template with a macro that will apply character styles to the selected text. It seemed that the Find/Replace feature would be a good place to start, but I think I've found a bug/limitation that prevents the macro from working as desired.
Here's my vba code:
Sub restyleSelection()
Dim r As Range
Set r = Selection.Range
With r.Find
.Style = ActiveDocument.Styles("Default Paragraph Font")
.Text = ""
.Replacement.Text = ""
.Replacement.Style = ActiveDocument.Styles("Emphasis")
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
End Sub
If I create a test document that contains a few paragraphs and select a few words in one of the paragraphs, then run the macro, the "Emphasis" style is applied not only to the selection, but beyond the end of the selection to the end of the document.
This behavior is the same using the actual GUI Find/Replace tool.
My question is: How can I overcome this bug/limitation and apply the character style ONLY within the selection/range?
A little more information:
What I really need the macro to do is apply certain formatting to the entire selection while maintaining the existing character styles in the selection. For example, if the selected text contains the Bold character style, the Italic character style, and the rest of it is Default Paragraph Font, the macro should replace Bold with "Revised Bold", replace "Italic" with "Revised Italic", and replace "Default Paragraph Font" with "Revised". That way, when I use the companion macro to "undo" the action of this macro, the original character styles (Bold, Italic, Default Paragraph Font) can be replaced.
SOLVED:
Here is the solution I finally arrived at:
Sub applyNewRevisedText
Dim r As Range ' Create a new Range object
Set r = Selection.Range ' Assign the current selection to the Range
Dim rng As Range
For Each rng In r.Words
Set rngStyle = rng.Style
Select Case rngStyle
Case "Bold"
rng.Style = ActiveDocument.Styles("New/Revised Text Bold")
Case "Italic"
rng.Style = ActiveDocument.Styles("New/Revised Text Emphasis")
Case Else
rng.Style = ActiveDocument.Styles("New/Revised Text")
End Select
Next rng
End Sub
To answer your direct question
My question is: How can I overcome this bug/limitation and apply the character style ONLY within the selection/range?
Does this not meet the need?:
Sub restyleSelection()
Selection.Style = ActiveDocument.Styles("Emphasis")
End Sub
EDIT:
Ok, based on your comment, what about something like:
Dim rng As Range
For Each rng In Selection.Words
If rng.Bold 'do something
Next rng
.Words will break up each word in the range into a collection of ranges. Then you can perform styling on each individual word based on its current style.
- Yes that works brilliantly if the entire selection is to be styled with "Emphasis." What I tried to convey (not very well perhaps) in my "A little more information" section is that I need to do an analysis of the selection and apply various character styles depending on the character styles that are present in the selection. That said, your solution is ideal if I can find a way to split a selection that is an aggregation of character styles into it's constituent parts, then apply the correct style to each part, and then put it back together. Jan 6 2012 at 14:23
- That definitely has me on the right track. The only thing that's holding me back now is that
If rng.Style = ActiveDocument.Styles("Default Paragraph Font")
doesn't seem to recognize base paragraph styles without character formatting. I suppose I can iterate through the 30-odd paragraph styles in the template if I need to and apply the proper chracter style as needed, but is there a way to find out whetherrng.Style
is a paragraph style or a character style? I see that there's a Type:=wdStyleTypeCharacter parameter for the Styles Object, but is there such a thing for the Style property? Jan 6 2012 at 16:49 - OK, I restructured the macro a bit to use a
Select Case
statement to apply the appropriate character styles to the words that already have character styles, and then theCase Else
applies the appropriate character style to anything that falls through (that is, does not have any character styles applied). You did in fact answer my question, I was just being lazy and looking for free additional answers :-) Thanks a lot. Jan 6 2012 at 17:37 - no problem. Glad it got you where you needed. Perhaps you could post an example of your final solution for future people in need? Jan 6 2012 at 18:27
- OK, I appended an example of the working solution to the question. Jan 6 2012 at 19:29
I had a slightly different problem and solved it without resorting to a loop. The code works NOT for text which is formatted directly, but it does work for text which is formatted with character styles.
Consider a part of the text being selected, either including or not including strings to which already some character style has been assigned.
If within the selected range no character style has been assigned yet, after the search the start of the selection won't be the same. If however at least one character style has been assigned the start of the selection will be the same as before the search. Now you can treat those two cases separately. In both cases all characters within the selection to which no character style had been assigned previously will now be linked to "myStyle".
Vst_Style = "myStyle"
ActiveDocument.Bookmarks.Add Name:="Range"
V_BMstart = Selection.Range.Start
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Default Paragraph Font")
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles(Vst_Style)
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
End With
Selection.Find.Execute
If Selection.Range.Start <> V_BMstart Then
Selection.GoTo what:=wdGoToBookmark, Name:="Range"
Selection.Style = Vst_Style
Else
Selection.GoTo what:=wdGoToBookmark, Name:="Range"
Selection.Find.Execute Replace:=wdReplaceAll
End If