Форум по VBA, Excel и Word

Sub макрос()
   
    Dim FileName As String, var
   
   
    '1. Проверка, что активный файл сохранён на жёстком диске.
        ' Иначе не известно, по какому пути сохранять.
    If ActiveDocument.Path = "" Then
        MsgBox "Активный файл не сохранён на жёстком диске, поэтому не известно, " & _
            "по какому пути сохранять копию.", vbExclamation
        Exit Sub
    End If
   
    '2. Копируем имя активного файла в переменную. Так удобнее писать код.
    FileName = ActiveDocument.Name
   
    '3. Если имя активного файла не имеет нужный вид.
    If Not FileName Like "##-##.##.## *" Then
        ' Просто добавляем спереди нужный фрагмент.
        FileName = "01-" & Format(Date, "dd.mm.yy") & " " & FileName
    '4. Если имя активного файла имеет нужный вид.
    Else
        '1) Формирование номера.
        ' Запись старого номера в переменную "var".
            ' Т.к. переднюю часть в переменной "FileName" я удалю.
        var = Left(FileName, 2)
        ' Увеличение номера на 1.
        var = CDbl(var) + 1
        ' добавление впередистоящего нуля.
        var = Format(var, "00")
        '2) Удаление впередистоящего текста из старого имени.
        FileName = Mid(FileName, Len("##-##.##.## ") + 1)
        '3) Добавление к имени нового номера и текущей даты.
        FileName = var & "-" & Format(Date, "dd.mm.yy") & " " & FileName
    End If
   
    '5. Создание копии активного файла.
    ActiveDocument.SaveAs2 FileName:=ActiveDocument.Path & "\" & FileName, FileFormat:=ActiveDocument.SaveFormat

End Sub