Replacement заменяет только последнее совпадение - VBA

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

Здравствуйте! Подскажите, пожалуйста, почему код заменят только данные введенные в переменную "НомерДоговора" а "DateDogovora" игнорирует?

Sub my_replace()
Dim DateDogovora As String
Dim НомерДоговора As String
DateDogovora = InputBox("Введите дату договора")
НомерДоговора = InputBox("Введите номер договора")
 
Selection.Find.Text = "ДД.ММ.ГГГГ"
Selection.Find.ClearFormatting
 
Selection.Find.Replacement.Text = DateDogovora
Selection.Find.Replacement.ClearFormatting

Selection.Find.Text = "ПРЭС-ГГ-XXXXX"
Selection.Find.ClearFormatting
 
Selection.Find.Replacement.Text = НомерДоговора
Selection.Find.Replacement.ClearFormatting

Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Решение задачи: «Replacement заменяет только последнее совпадение»

textual
                            Листинг программы 
                        

                            Sub my_rep_fun(textreplace As String, args As String)
 
    Selection.Find.Text = textreplace
    Selection.Find.ClearFormatting
    
    Selection.Find.Replacement.Text = args
    Selection.Find.Replacement.ClearFormatting
    
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub
 
 
Sub my_replace()
Dim ДатаДоговора As String
Dim НомерДоговора As String
ДатаДоговора = InputBox("Введите дату договора", , Date)
НомерДоговора = InputBox("Введите номер договора", , 1111)
''да и текст , в котором надо что-то заменить, [B]должен[/B] быть выделен(или раскомменчена cлед строка)
Word.ActiveDocument.Select
Call my_rep_fun("ДД.ММ.ГГГГ", ДатаДоговора)
Call my_rep_fun("ПРЭС-ГГ-XXXXX ", НомерДоговора)
 
End Sub
                        