0
这是我的问题。Excel VBA打印机API，设置颜色和双工
我正在尝试访问打印机并更改颜色和双面打印设置。到目前为止，我拥有的代码允许我更改联网打印机的用户首选项。但我在下面有两个问题。
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
任何帮助，您可以提供将不胜感激！这几周我一直在用头撞墙。
如果这只是关于在几种可能的设置之间切换打印选项，我会建议使用您现在试图通过VBA设置的选项向Windows添加新的打印机。然后，您可以限制自己选择合适的打印机。 – jkpieterse
@jkpieterse。嗨，感谢您的回应，我曾考虑过这一点，但不幸的是，它们是网络打印机，我的公司不允许我添加额外的打印机。 – atame