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

Формулировка задачи:

Доброго времени суток. На основе тем:Выделение фрагмента текста в Word, заключенного между заданными словами иЗамена текста в выделенном фрагменте пытаюсь реализовать требуемый функционал.

Задача.

Есть текст

Собачка...ля-ля-ля...Кошка Кошка...ля-ля-ля...Лягушка Лягушка...ля-ля-ля...Лев

Нужно вот эти ля-ля-ля заменить на другой текст, в зависимости от контекста в целом, тоесть: если внутри Собачка-Кошка, то ля-ля-ля меняем на гав-гав, если внутри чуастка Кошка-Лягушка, то ля-ля-ля меняем на Мяу-мяу.. и т.д. Причем фрагмент Собачка-Кошка может встречаться несколько раз в документе.

Собственно код:

участок текста вроде как выделяется, но вот потом замена происходит не в одном участке, а по всему файлу.

                    Листинг программы
                
 
                        
                          
                    
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

Решение задачи: «Выполнить замену слова в выделенных фрагментах текста»

textual
                            Листинг программы 
                        
Selection.Range.Find.Execute ",", Wrap:=wdFindStop, replacewith:="."