Здравствуйте! Необходимо найти в штампах дату формата 01.XX.202X и заменить на текущую (текущий месяц и год, а день оставляем всегда "01"). Таких штампов много, а даты могут быть разные, поэтому неудобно прописывать искомую дату или пользоваться инструментом "Поиск и замена текста".
На текущий момент написан такой код, который исправно работает, если задана искомая дата(oldDate):
Проблема заключается в самом поиске старой даты в штампах. Помогите, пожалуйста, придумать, как найти oldDate! Может быть можно найти дату по ее началу: "01", а потом записать следующие 8 символов? Или найти позицию в тексте?
На текущий момент написан такой код, который исправно работает, если задана искомая дата(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 символов? Или найти позицию в тексте?