Developing.ru

Код: Выделить всё

Private Sub сверка_даты_титульный()
Const P1 As Long = 1 ' первая траница поиска
Const P2 As Long = 100 ' последняя страница поиска
Const T As String = "<[0-9]{1;2}>[. ^s]@[А-ЯЁа-яё0-9]@[. ^s]@[0-9]{4}>" ' маска поиска
Dim D As Document, R As Range, N As Long, P As Long, a As String, c As Date
 
    ' документ
    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
           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
        
        a = Selection.Text   'найденный выше текст
    If IsDate(a) Then
    Else
    End If
 
    If IsDate(a) Then
'
        c = CDate(a)
            
            If Day(c) = Day(Date + -1) And Month(c) = Month(Date + -1) And Year(c) = Year(Date + -1) Then
            Else
                MsgBox (a & " не соответствует системной дате " & Date)
            End If
    End If
                       R.Select
           R.Collapse Direction:=wdCollapseEnd
    Loop
End Sub