[CDR 2017-2021] Поиск и замена даты по заданному формату

[jam]

Здравствуйте! Необходимо найти в штампах дату формата 01.XX.202X и заменить на текущую (текущий месяц и год, а день оставляем всегда "01"). Таких штампов много, а даты могут быть разные, поэтому неудобно прописывать искомую дату или пользоваться инструментом "Поиск и замена текста".

На текущий момент написан такой код, который исправно работает, если задана искомая дата(oldDate):

Sub replace_date()

    Dim d As Document
    Set d = ActiveDocument
    Dim sr As ShapeRange
    Dim s As Shape
    Dim NewDate, strOrig, strReplaced, OldDate, a2 As String
    Dim C As TextRange
    pgs = d.Pages.Count
    
    a = DatePart("m", Now) 'текущий месяц
    
    If a < 10 Then
        a2 = "0" + CStr(a)
    Else: a2 = CStr(a)
    End If

    NewDate = "01." + a2 + "." + CStr(DatePart("yyyy", Now))
    
    For i = 1 To pgs
    
        lrs = d.Pages(i).Layers.Count
            For j = 1 To lrs 'находим слой со штампом, открываем и выходим из цикла
                lrsname = d.Pages(i).Layers(j).Name
                If InStr(1, lrsname, "Штамп") <> 0 Then
                    d.Pages(i).Layers(j).Editable = True
                    d.Pages(i).Layers(j).Activate
                    Exit For
                End If
            Next j
    
        Set sr = ActivePage.ActiveLayer.FindShapes(, cdrTextShape)
        For Each s In sr 'заменяем oldDate на NewDate, закрываем слой и выходим из цикла
            strOrig = s.Text.Story
            'oldDate=
            strReplaced = Replace(strOrig, OldDate, NewDate)
            If strOrig <> strReplaced Then
                s.Text.Story = strReplaced
                d.Pages(i).Layers(j).Editable = False
                Exit For
            End If
        Next s
        
    Next i

End Sub

Проблема заключается в самом поиске старой даты в штампах. Помогите, пожалуйста, придумать, как найти oldDate! Может быть можно найти дату по ее началу: "01", а потом записать следующие 8 символов? Или найти позицию в тексте?

 

[Drawer]

как найти oldDate

Попробуйте так. Проверить не могу, но по идее должно работать

Dim regex : Set regex = New RegExp
regex.Pattern = "01\.\d{2}\.202\d"'регулярное выражение для поиска
oldDate = regex.Execute(strOrig)(0)

 

[~RA~]

Таких штампов много, а даты могут быть разные, поэтому неудобно прописывать искомую дату или пользоваться инструментом "Поиск и замена текста".

В кореле нельзя регулярные выражения в поиск и замену ставить?

 

[dastin]

CdrToolsEx 2.1​

текущая дата - вбивается руками, затем
выделить всё и ...

 

[jam]

Попробуйте так. Проверить не могу, но по идее должно работать

Dim regex : Set regex = New RegExp
regex.Pattern = "01\.\d{2}\.202\d"'регулярное выражение для поиска
oldDate = regex.Execute(strOrig)(0)

Большое спасибо!!! Не знала про регулярные выражения, но это именно то, что мне было нужно!
Правда выдавало ошибку, немного по другому написала и заработало:

    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    With regex
        .Pattern = "01\.\d{2}\.202\d"
    End With
...
    If InStr(1, strOrig, "01.") <> 0 Then
        OldDate = regex.Execute(strOrig)(0)
    End If
...

Спасибо за помощь!!!

 

[jam]

В кореле нельзя регулярные выражения в поиск и замену ставить?

Попробовала, не находит

 

[DukereD]

реализовал в докере регулярки