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