Find/Replace macro only limited to selection when entire paragraph is selected

Hello,

I've created a macro in Word 2007 that is designed to apply special
formatting to the current selection. When an entire paragraph is
selected, it works beatifully. However, when a few words within the
paragraph are selected, the changes continue beyond the selection until
the end of the document.

Here is the VBA code:

Sub applyNewRevisedText(control As IRibbonControl)
'
' applyNewRevisedText Macro
'
' This macro applies a magenta font color
' and Italic character formatting to the selected text.
' Bold, Bold Italic, Italic, Underlined, and Emphasis
' text is maintained so that when the New/Revised text
' formatting is removed, these formatting attributes
' are maintained.
'

' Change all instances of the Default Paragraph Font style
' to New/Revised Text.
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Default Paragraph Font")
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles( _
"New/Revised Text")
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With

' Change all instances of the Emphasis character style
' to New/Revised Emphasis.
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Emphasis")
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles( _
"New/Revised Text Emphasis")
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With

' Change all instances of the Bold character style
' to New/Revised Bold.
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Bold")
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles( _
"New/Revised Text Bold")
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
End Sub

You can see that what I'm trying to do is a little more complex than
simply exchanging one style for another in the entire selection. Rather,
I need to tag the special character styles so that they are properly
maintained while the "New/Revised" formatting is applied. Then, I have a
corresponding macro that will reverse the process and reapply the
"standard" styles.

Any advice on how to make this macro apply the formatting to *only* the
selection, even if only a word or two in a paragraph are selected?

Any help is greatly appreciated.

Paul Burton