2
votes

The following code works, but it performs everything on the entire document. I'd like to highlight a block of text, then when I run the macro only have it work on the highlighted text. How do I do that? Thanks...

Sub DoCodeNumberStyle(numchars As String)

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "(^13)([0-9]{" + numchars + "}) "
        .Replacement.Text = "\1###\2$$$ "
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Style = ActiveDocument.Styles("CodeNumber")
    With Selection.Find
        .Text = "###([0-9]{" + numchars + "})$$$"
        .Replacement.Text = "\1"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Sub CodeNumberStyle()
    DoCodeNumberStyle ("1")
    DoCodeNumberStyle ("2")
End Sub

PostScript:

One additional thing I've discovered: if you do more than one find on a Selection, the first find loses/changes the Selection, so the others are no longer bounded by the original Selection (and a wdReplaceAll will continue to the end of the document). To fix this, capture the Selection into a Range. Here's the final version of my method, which now does everything I need, is restricted to the original highlighted selection (even with 3 find-and-replacements), and has also been minimized, code-wise:

Sub AAACodeNumberStyleHighlightedSelection()

    With Selection.Range.Find
        .ClearFormatting
        .Style = ActiveDocument.Styles("Code")
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False

        ' First line:
        .Text = "1   //"
        .Replacement.Text = "###1$$$   //"
        .MatchWildcards = False
        .Execute Replace:=wdReplaceAll

        ' Rest of lines:
        .Text = "(^13)([0-9]{1,2}) "
        .Replacement.Text = "\1###\2$$$ "
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll

        ' Now style the line numbers:
        .Text = "###([0-9]{1,2})$$$"
        .Replacement.Text = "\1"
        .Replacement.Style = ActiveDocument.Styles("CodeNumber")
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll

    End With

End Sub
3

3 Answers

2
votes

Change .Wrap to wdFindStop and this should work for you. I think this might be a minor Word bug; the documentation says that the Wrap value

sets what happens if the search begins at a point other than the beginning of the document and the end of the document is reached (or vice versa if Forward is set to False) or if the search text isn't found in the specified selection or range.

But it seems like it forces the Find to go to the end of the document rather than taking the selection into account. Anyway, there's no need for wdFindAsk if you only plan to run this on selections.

0
votes

I, too, found that even when beginning a FIND loop on a range, the range is redefined by FIND, and so continuous loop on .execute goes beyond the original range to the end of the document. wdFindStop stops only at the end of the document, not at the end of the original range.

So, I inserted an IF statement:

do while .find.found ... If .find.parent.InRange(doc.Bookmarks("BODY").Range) = False Then Exit Do ... .execute loop

0
votes
Set myRange = Selection.Range
 myRange.Select
    With Selection.Find
        .Text = "Apple"
        .Replacement.Text = "Banana"
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        '.MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

   myRange.Select
        With Selection.Find
        .Text = "red"
        .Replacement.Text = "yellow"
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        '.MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll