API Excel VBA для печати, цвет и дуплекс

вот моя проблема.

Я пытаюсь получить доступ к принтеру и изменить настройки цвета и дуплекса. Пока что код, который я позволяю мне изменять пользовательские настройки сетевого принтера. Но у меня есть следующие две проблемы ниже.

1) Кодовый набор, установленный на принтере либо симплексным, либо дуплексным, как и предполагалось, однако, не устанавливает правильную настройку цвета!

2) Excel не автоматически подбирает новые настройки, мне все равно нужно войти и вручную нажать кнопку сброса, чтобы новые изменения повлияли.

введите описание изображения здесь

Вот код, который я использую:

Private Type PRINTER_INFO_9 pDevmode As Long ' Pointer to DEVMODE End Type Private Type DEVMODE dmDeviceName As String * 32 dmSpecVersion As Integer dmDriverVersion As Integer dmSize As Integer dmDriverExtra As Integer dmFields As Long dmOrientation As Integer dmPaperSize As Integer dmPaperLength As Integer dmPaperWidth As Integer dmScale As Integer dmCopies As Integer dmDefaultSource As Integer dmPrintQuality As Integer dmColor As Integer dmDuplex As Integer dmYResolution As Integer dmTTOption As Integer dmCollate As Integer dmFormName As String * 32 dmUnusedPadding As Integer dmBitsPerPel As Integer dmPelsWidth As Long dmPelsHeight As Long dmDisplayFlags As Long dmDisplayFrequency As Long dmICMMethod As Long dmICMIntent As Long dmMediaType As Long dmDitherType As Long dmReserved1 As Long dmReserved2 As Long End Type Private Declare Function OpenPrinter Lib "winspool.drv" Alias _ "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, _ pDefault As Any) As Long Private Declare Function GetPrinter Lib "winspool.drv" Alias _ "GetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _ buffer As Long, ByVal pbSize As Long, pbSizeNeeded As Long) As Long Private Declare Function SetPrinter Lib "winspool.drv" Alias _ "SetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _ pPrinter As Any, ByVal Command As Long) As Long Private Declare Function DocumentProperties Lib "winspool.drv" _ Alias "DocumentPropertiesA" (ByVal hwnd As Long, _ ByVal hPrinter As Long, ByVal pDeviceName As String, _ ByVal pDevModeOutput As Long, ByVal pDevModeInput As Long, _ ByVal fMode As Long) As Long Private Declare Function ClosePrinter Lib "winspool.drv" _ (ByVal hPrinter As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _ (pDest As Any, pSource As Any, ByVal cbLength As Long) Private Const DM_IN_BUFFER = 8 Private Const DM_OUT_BUFFER = 2 Private Sub CommandButton1_Click() Dim sPrinterName As String Dim my_printer_address As String Dim hPrinter As Long Dim Pinfo9 As PRINTER_INFO_9 Dim dm As DEVMODE Dim yDevModeData() As Byte Dim nRet As Long my_printer_address = Application.ActivePrinter 'slice string for printer name (minus port name) sPrinterName = Left(my_printer_address, InStr(my_printer_address, " on ") - 1) 'Open Printer nRet = OpenPrinter(sPrinterName, hPrinter, ByVal 0&) 'Get the size of the DEVMODE structure nRet = DocumentProperties(0, hPrinter, sPrinterName, 0, 0, 0) If (nRet < 0) Then MsgBox "Cannot get the size of the DEVMODE structure.": Exit Sub 'Get DEVMODE Structure ReDim yDevModeData(nRet + 100) As Byte nRet = DocumentProperties(0, hPrinter, sPrinterName, VarPtr(yDevModeData(0)), 0, DM_OUT_BUFFER) If (nRet < 0) Then MsgBox "Cannot get the DEVMODE structure." Exit Sub End If 'Copy the DEVMODE structure Call CopyMemory(dm, yDevModeData(0), Len(dm)) 'Change DEVMODE Stucture as required dm.dmColor = 1 ' 1 = colour, 2 = b/w dm.dmDuplex = 2 ' 1 = simplex, 2 = duplex 'Replace the DEVMODE structure Call CopyMemory(yDevModeData(0), dm, Len(dm)) 'Verify DEVMODE Stucture nRet = DocumentProperties(0, hPrinter, sPrinterName, VarPtr(yDevModeData(0)), VarPtr(yDevModeData(0)), DM_IN_BUFFER Or DM_OUT_BUFFER) Pinfo9.pDevmode = VarPtr(yDevModeData(0)) 'Set DEVMODE Stucture with any changes made nRet = SetPrinter(hPrinter, 9, Pinfo9, 0) If (nRet <= 0) Then MsgBox "Cannot set the DEVMODE structure.": Exit Sub 'Close the Printer nRet = ClosePrinter(hPrinter) End Sub 

Любая помощь, которую вы можете предоставить, будет очень признательна! Я уже несколько недель ударяю головой о стену!

После некоторых обширных исследований я нашел ответ, который я искал. Я разместил его здесь, если у кого-то ситуация аналогичная.

Основная проблема, с которой я столкнулась, заключалась в том, чтобы заставить Excel принять новые изменения с закрытием книги или перейти к настройкам печати и нажать «Сброс».

Решение, с которым я столкнулся, состояло в том, чтобы временно установить активный принтер на другой принтер и установить его обратно на принтер, параметры которого были изменены, это заставляет Excel забрать новые настройки.

Вот публичные типы, функции и константы:

 Public Type PRINTER_INFO_9 pDevmode As Long '''' POINTER TO DEVMODE End Type Public Type DEVMODE dmDeviceName As String * 32 dmSpecVersion As Integer: dmDriverVersion As Integer dmSize As Integer dmDriverExtra As Integer dmFields As Long dmOrientation As Integer dmPaperSize As Integer dmPaperLength As Integer dmPaperWidth As Integer dmScale As Integer dmCopies As Integer dmDefaultSource As Integer dmPrintQuality As Integer dmColor As Integer dmDuplex As Integer dmYResolution As Integer dmTTOption As Integer dmCollate As Integer dmFormName As String * 32 dmUnusedPadding As Integer dmBitsPerPel As Integer dmPelsWidth As Long dmPelsHeight As Long dmDisplayFlags As Long dmDisplayFrequency As Long dmICMMethod As Long dmICMIntent As Long dmMediaType As Long dmDitherType As Long dmReserved1 As Long dmReserved2 As Long End Type Public Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, pDefault As Any) As Long Public Declare Function GetPrinter Lib "winspool.drv" Alias "GetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, buffer As Long, ByVal pbSize As Long, pbSizeNeeded As Long) As Long Public Declare Function SetPrinter Lib "winspool.drv" Alias "SetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Any, ByVal Command As Long) As Long Public Declare Function DocumentProperties Lib "winspool.drv" Alias "DocumentPropertiesA" (ByVal hWnd As Long, ByVal hPrinter As Long, ByVal pDeviceName As String, _ ByVal pDevModeOutput As Long, ByVal pDevModeInput As Long, _ ByVal fMode As Long) As Long Public Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal cbLength As Long) Public Const DM_IN_BUFFER = 8 Public Const DM_OUT_BUFFER = 2 

Это обычная программа, которую я использую для установки новых значений:

 Public Sub SetPrinterProperty(ByVal sPrinterName As String, ByVal iPropertyType As Long) Dim PrinterName, sPrinter, sDefaultPrinter As String Dim Pinfo9 As PRINTER_INFO_9 Dim hPrinter, nRet As Long Dim yDevModeData() As Byte Dim dm As DEVMODE '''' STROE THE CURRENT DEFAULT PRINTER sDefaultPrinter = sPrinterName '''' USE THE FULL PRINTER ADDRESS TO GET THE ADDRESS AND NAME MINUS THE PORT NAME PrinterName = Left(sDefaultPrinter, InStr(sDefaultPrinter, " on ") - 1) '''' OPEN THE PRINTER nRet = OpenPrinter(PrinterName, hPrinter, ByVal 0&) '''' GET THE SIZE OF THE CURRENT DEVMODE STRUCTURE nRet = DocumentProperties(0, hPrinter, PrinterName, 0, 0, 0) If (nRet < 0) Then MsgBox "Cannot get the size of the DEVMODE structure.": Exit Sub '''' GET THE CURRENT DEVMODE STRUCTURE ReDim yDevModeData(nRet + 100) As Byte nRet = DocumentProperties(0, hPrinter, PrinterName, VarPtr(yDevModeData(0)), 0, DM_OUT_BUFFER) If (nRet < 0) Then MsgBox "Cannot get the DEVMODE structure.": Exit Sub '''' COPY THE CURRENT DEVMODE STRUCTURE Call CopyMemory(dm, yDevModeData(0), Len(dm)) '''' CHANGE THE DEVMODE STRUCTURE TO REQUIRED dm.dmDuplex = iPropertyType ' 1 = simplex, 2 = duplex '''' REPLACE THE CURRENT DEVMODE STRUCTURE WITH THE NEWLEY EDITED Call CopyMemory(yDevModeData(0), dm, Len(dm)) '''' VERIFY THE NEW DEVMODE STRUCTURE nRet = DocumentProperties(0, hPrinter, PrinterName, VarPtr(yDevModeData(0)), VarPtr(yDevModeData(0)), DM_IN_BUFFER Or DM_OUT_BUFFER) Pinfo9.pDevmode = VarPtr(yDevModeData(0)) '''' SET THE DEMODE STRUCTURE WITH ANY CHANGES MADE nRet = SetPrinter(hPrinter, 9, Pinfo9, 0) If (nRet <= 0) Then MsgBox "Cannot set the DEVMODE structure.": Exit Sub '''' CLOSE THE PRINTER nRet = ClosePrinter(hPrinter) '''' GET THE FULL PRINTER NAME FOR THE CUTE PDF WRITER sPrinter = GetPrinterFullName("CutePDF") '''' CHECK TO MAKE SURE THE CUTEPDF WAS FOUND If sPrinter <> vbNullString Then '''' THIS FORCES EXCEL TO ACCEPT THE NEW CHANGES THAT HAVE BEEN MADE TO THE PRINTER SETTINGS '''' SET THE ACTIVE PRINTER TEMPERARILLY TO THE CUTE PDF WRITER Application.ActivePrinter = sPrinter '''' SET THE PRINTER BACK TO THE DEFAULY FOLLOW ME. Application.ActivePrinter = sDefaultPrinter End If End Sub 

Затем я вызываю любое из этих двух подмножеств для установки предпочтений набора:

 Public Sub SetDuplex(ByVal sPrinterName As String, iDuplex As Long) SetPrinterProperty sPrinterName, iDuplex End Sub Public Sub SetSimplex(ByVal sPrinterName As String, iDuplex As Long) SetPrinterProperty sPrinterName, iDuplex End Sub 
Interesting Posts

Проблемы с списками и матрицей с использованием xlrd и python

Необходимо написать скрипт find / replace для элементов в текстовом файле

Поиск и удаление нулей из данных

Что выиграть cmd, чтобы открыть конкретную таблицу в Excel?

VBA извлекает HTML-данные в Интернете после заполнения выпадающих списков и отправки поиска

Веб-скребок с использованием excel VBA

Interop Excel не закрывает процесс

Импортируйте второй лист распространения в проект Microsoft.Office.Interop.Excel C #

Excel Solver, начальное значение переменной ячейки влияет на решателя

Excel консолидирует дает неправильный список уникальных значений

Необходимо скопировать ячейку на другой лист, а затем перезаписать новое значение (цикл)

Распечатать левый номер столбца X количество раз Excel

Копирование ячеек на основе макроса строк

Скопируйте рабочий лист из одной книги в другую с помощью Openpyxl

Смещение с использованием значения ячейки

Давайте будем гением компьютера.