Excel VBA打印机API，设置颜色和双工

Question

这是我的问题。

我正在尝试访问打印机并更改颜色和双工设置。到目前为止，我的代码允许我更改联网打印机的用户首选项。但是我有以下两个问题。

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

您将提供的任何帮助将不胜感激！这几个星期以来，我一直在用头撞墙！

Answer 1

另一答案