How to replace Microsoft Word character style with range / selection in VBA?

Question

I am working on a Word 2007 template with a macro that will apply character styles to the selected text. The Find / Replace function seemed to be a good place to start, but I think I found an error / limitation that prevents the macro from working as desired.

Here is 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 containing several paragraphs and select several words in one of the paragraphs, then run the macro, the Accent style applies not only to the selection, but also to the end of the selection at the end of the document.

This is the same as the actual GUI search / replace tool.

My question is: How can I overcome this error / limitation and apply the character style ONLY within the selection / range?

A bit more info:
What I really need to do the macro is to apply certain formatting to the whole selection, while preserving the existing character styles. For example, if the selected text contains a bold style, an Italian character style, and the rest is the default font, the macro should replace Bold with “Revised Bold”, replace “Italic” with “Revised Italic” and replace “Default Paragraph Font” with "Revised." Thus, when I use the companion macro to "undo" the action of this macro, I can replace the original character styles (Bold, Italic, Default Paragraph Font).

SOLVE:
Here is the solution I finally came to:

 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 

Answer 1

To answer your direct question

My question is : how can I overcome this error / restriction and apply the character style ONLY within the selection / range?

Does this fit?

 Sub restyleSelection() Selection.Style = ActiveDocument.Styles("Emphasis") End Sub 

EDIT:

Well, based on your comment, something like:

 Dim rng As Range For Each rng In Selection.Words If rng.Bold 'do something Next rng 

. Words will break each word in a range into a set of ranges. You can then style each individual word, depending on its current style.

Answer 2

I had a slightly different problem, and I solved it without resorting to a loop. The code does NOT work for text that is formatted directly, but it works for text that is formatted using character styles.

Consider some of the selected text, including or not including lines that have already been assigned a certain character style.

If the character style has not yet been assigned in the selected range, after the search the beginning of the selection will be different. If at least one character has been assigned, the start of the selection will be the same as before the search. Now you can consider these two cases separately. In both cases, all characters within the selection to which a character style was not previously assigned will now be associated with "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