Выполнить замену слова в выделенных фрагментах текста

Dim r
Dim s
Set r = wordApp.ActiveDocument.Range
With r.Find
    .ClearFormatting
    .Text = "Собачка*Кошка"
    .Forward = True
    .Wrap = 1
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = True
    If .Execute Then
       wordApp.ActiveDocument.Range(r.Start, r.End).Select
       Set s = wordApp.Selection.Range'пытался передать выделение,но это вообще не работает
        With s.Find
            .ClearFormatting
            .Text = "ля-ля-ля"
            .Replacement.Text = "Гав-гав-гав"
            .Forward = True
            .Wrap = 1
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = True
        End With
        s.Find.Execute Replace:=1
 
    Else
        MsgBox "Не нашли выделение", vbExclamation
    End If

Option Base 1
Option Compare Text 'это чтобы не учитывать регистр букв найденного слова
 
Sub ВначалеКОШКА_мяу()
Dim abz As paragraph, N As Long 'переменная для работы с абзацем и его номер
Dim СЛОВО, i 'переменные для массива искомых слов и их индексации (пока - без неё)
Dim k As Long  'счётчик изменённых строк (абзацев, где вначале стоит СЛОВО (i))
СЛОВО = Array("Кошка", "Собачка", "Лягушка")
 
'Для надёжности сначала заменим разрывы строк (код 11) на символы абзаца (код 13)
ActiveDocument.Range.Text = Replace(ActiveDocument.Range.Text, Chr(11), Chr(13))
'Теперь каждая строка (в т. ч. пустая) - это отдельный абзац.
 
For N = 1 To ActiveDocument.Paragraphs.Count 'перебор всех абзацев
    Set abz = ActiveDocument.Paragraphs(N)
    With abz.Range 'работаем с очередным абзацем
        While .Characters(1) = " ": abz.Range.Characters(1).Delete: Wend
        'выше это был убор начальных пробелов
        If MsgBox("Возможно, замена: " & .Words(1), vbOKCancel) = vbOK Then Else Exit Sub
            Select Case .Words(1)
            Case СЛОВО(1)
                .Text = Replace(.Text, "ля-ля-ля", "мяу-мяу"): k = k + 1
            Case СЛОВО(2)
                .Text = Replace(.Text, "ля-ля-ля", "гав-гав"): k = k + 1
            Case СЛОВО(3)
                .Text = Replace(.Text, "ля-ля-ля", "ква-ква"): k = k + 1
            End Select
    End With
Next
End Sub