Поиск в нужном диапазоне страниц worda

Public Sub Replace_On_The_Pages()

Const P1 As Long = 2 ' первая страница поиска
Const P2 As Long = 4 ' последняя страница поиска
Const T As String = "<[0-9]{1;2}>[ ^s]@[А-ЯЁа-яё]@[ ^s]@[0-9]{4}>" ' маска поиска

Dim D As Document, R As Range, N As Long, P As Long

    ' документ
    Set D = ActiveDocument
    ' разбиваем документ на страницы
    D.Repaginate
    ' область начала поиска
    Set R = D.GoTo(wdGoToPage, wdGoToAbsolute, P1)
    ' параметры поиска
    With R.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Forward = True
        .Wrap = wdFindStop
        .MatchWildcards = True
        .Text = T
        ' параметры замены
        '.Replacement.Text = ""
    End With
    ' цикл поиска
    N = 0 ' счетчик
    Do
        ' ищем
        R.Find.Execute
        If R.Find.Found <> True Then Exit Do ' не нашли
        P = R.Information(wdActiveEndPageNumber) ' страница находки
        If P > P2 Then Exit Do ' выход за диапазон страниц
        ' нашли
        N = N + 1
        ' делаем что-то
        '...
        ' пример замены
        'R.Collapse Direction:=wdCollapseStart
        'R.Find.Execute Replace:=wdReplaceOne
        '...
        ' сообщаем пользователю
        R.Select
        If MsgBox("Находка " & N & " / Страница " & P, vbOKCancel) <> vbOK Then Exit Do
        '...
        ' ищем далее
        R.Collapse Direction:=wdCollapseEnd
    Loop
    MsgBox "Всего найдено " & N
    
End Sub

Const T As String = "<[0-9]{1;2}>[. ^s]@[А-ЯЁа-яё0-9]@[. ^s]@[0-9]{4}>" ' маска поиска