【发布时间】：2017-04-12 10:30:38
【问题描述】：
这是我的问题。
我正在尝试访问打印机并更改颜色和双面设置。到目前为止，我拥有的代码允许我更改联网打印机的用户首选项。但是我有以下两个问题。
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。您好，感谢您的回复，我已经考虑过了，但不幸的是它们是联网打印机，我的公司不允许我添加额外的打印机。
标签： vba excel printing excel-2010