чтобы печатать книгу на конкретный принтер: в модуль книги вставьте эту процедуру [vba]
Код
Private Sub Workbook_BeforePrint(Cancel As Boolean) Const strPrinter As String = "doPDF 8 (Ne04:)" Application.ActivePrinter = strPrinter End Sub
[/vba] в константу strPrinter запишите принтер,на который должна печататься книга. чтобы узнать имя принтера для константы strPrinter,сделайте так:1)выберите нужный принтер,2)в окне Immediate вставьте и запустите этот скрипт: [vba]
Код
Print application.ActivePrinter
[/vba]
чтобы печать конкретный лист на конкретный принтер,попробуйте такое(имена принтеров и листов вам нужно самим указать ) [vba]
Код
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
[/vba]
чтобы печатать книгу на конкретный принтер: в модуль книги вставьте эту процедуру [vba]
Код
Private Sub Workbook_BeforePrint(Cancel As Boolean) Const strPrinter As String = "doPDF 8 (Ne04:)" Application.ActivePrinter = strPrinter End Sub
[/vba] в константу strPrinter запишите принтер,на который должна печататься книга. чтобы узнать имя принтера для константы strPrinter,сделайте так:1)выберите нужный принтер,2)в окне Immediate вставьте и запустите этот скрипт: [vba]
Код
Print application.ActivePrinter
[/vba]
чтобы печать конкретный лист на конкретный принтер,попробуйте такое(имена принтеров и листов вам нужно самим указать ) [vba]
Код
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
[/vba] если нужны названия принтеров, вот функция, возвращающая массив названий всех установленных принтеров [vba]
Код
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
[/vba]
В модуль ЭтаКнига [vba]
Код
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
[/vba] если нужны названия принтеров, вот функция, возвращающая массив названий всех установленных принтеров [vba]
Код
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