Sub Change_date()
    ActiveWorkbook.Names.Add Name:="myDate", RefersToR1C1:=Format(Date, "dd.mm.yyyy")
    Dim DateA
    txt_ = "Введите актуальную дату."
    txt_ = txt_ & vbLf & "Вызвать изменение даты можно нажав Ctrl+Q"
    Do
        DateA = InputBox(txt_, "Запрос.", Date + 1)
    Loop While Not IsDate(DateA)
    ActiveWorkbook.Names("myDate").RefersToR1C1 = DateA
    
    ActiveWorkbook.Names.Add Name:="yearApple", RefersToR1C1:=Format(Date, "yyyy")
    Dim DateB
    txt_ = "Введите актуальный год для яблока."
    txt_ = txt_ & vbLf & "Вызвать изменение даты можно нажав Ctrl+Q"
    Do
        DateB = InputBox(txt_, "Запрос.", Format(Date + 1, "yyyy"))
    Loop While Not IsDate("1/1/" & DateB)
    ActiveWorkbook.Names("yearApple").RefersToR1C1 = DateB
End Sub

Sub Печать_на_Zebra()
Dim aPr$, s$, AllPrinters As Object, printer As Object, n%, m, primary_printer$, print_name$
primary_printer = Sheets("printer").Cells(1, "a").Value ' Вместо "doPDF v7" - впишите нужный принтер по умолчанию
' primary_printer = "ZDesigner GC420d (перенаправлено 16)" ' Вместо "doPDF v7" - впишите нужный принтер по умолчанию
aPr = Application.ActivePrinter
Set AllPrinters = GetObject("winmgmts://./root/CIMV2").ExecQuery("SELECT * FROM Win32_Printer", , 48)
'Получаем список принтеров
    For Each printer In AllPrinters
        n = n + 1
        s = s & vbCr & n & ": " & printer.Name
        If printer.Name = primary_printer Then print_name = primary_printer: Exit For ' если primary_printer найден в списке доступных
    Next
    s = Right(s, Len(s) - 1)
'Если такого принтера не найдено:
If print_name = "" Then
    If InStr(1, s, vbCr, vbTextCompare) = 0 Then MsgBox "Error no printers": Exit Sub
    m = Split(s, vbCr)
    n = Val(InputBox("input Number of printer:" & vbCr & s, "Not found:" & primary_printer, 1))
    If n > UBound(m) Or n = 0 Then MsgBox "Error no printers with this number": Exit Sub
    print_name = Split(m(n - 1), " ", 2)(1)
    Sheets("printer").Cells(1, "a").Value = print_name
End If
'===============================
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:=print_name
'Application.ActivePrinter = aPr ' Возврат активного принтера
End Sub