Private Sub Workbook_BeforePrint(Cancel As Boolean)
        Const strPrinter As String = "doPDF 8 (Ne04:)"
        Application.ActivePrinter = strPrinter
End Sub

Print application.ActivePrinter

Private Sub Workbook_BeforePrint(Cancel As Boolean)
      Const strPrinter1 As String = "doPDF 8 (Ne04:)"
      Const strPrinter2 As String = "doPDF 8 (Ne04:)"
      If ActiveSheet.Name = "Лист1" Then
          Application.ActivePrinter = strPrinter1
      Else
          Application.ActivePrinter = strPrinter2
      End If
End Sub

Private Function GetPrinter$(PrinterName$)
       Dim StrKey$: StrKey = "HKCU\Software\Microsoft\Windows NT\CurrentVersion\Devices\"
       With CreateObject("WScript.Shell")
           GetPrinter = PrinterName & " (" & Split(.RegRead(StrKey & PrinterName), ",")(1) & ")"
       End With
End Function
Sub DefinePrinters()
       On Error Resume Next
       Me.CustomDocumentProperties.Add "книга", 0, 4, "Принтер" 'задаем принтер для этой книги
       CustomDocumentProperties("книга") = "Принтер" 'если принтер для этой книги был задан раньше
       Me.CustomDocumentProperties.Add "Лист1", 0, 4, "Canon Inkjet iP4600 series" 'задаем принтер для Листа1
       CustomDocumentProperties("Лист1") = "Canon Inkjet iP4600 series" 'если принтер для Листа1 был задан раньше
       Me.CustomDocumentProperties.Add "Лист2", 0, 4, "Принтер2"
       CustomDocumentProperties("Лист2") = "Принтер2"
       Me.CustomDocumentProperties.Add "Лист3", 0, 4, "Принтер3"
       CustomDocumentProperties("Лист3") = "Принтер3"
End Sub
Private Sub Workbook_BeforePrint(Cancel As Boolean)
       With ActiveWindow.SelectedSheets
           Application.ActivePrinter = GetPrinter(CustomDocumentProperties(IIf(.Count > 1, "книга", .Item(1).Name)))
       End With
End Sub

Function GetPrinters() As Variant
      Dim coll As Collection: Set coll = New Collection
      Dim StrKey$: StrKey = "HKCU\Software\Microsoft\Windows NT\CurrentVersion\Devices\"
      Dim n&, arr()
      With GetObject("winmgmts://./root/CIMV2")
          For Each Printer In .ExecQuery("SELECT * FROM Win32_Printer", , 48)
              ReDim Preserve arr(n): arr(n) = Printer.Name n = n + 1
          Next
      End With
      GetPrinters = arr
End Function