Question

这是我的问题。

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

1）代码将打印机设置为单面打印或双面打印，但是没有正确设置颜色首选项！

2）Excel不会自动获取新设置，我仍然需要进入并手动点击重置按钮才能使新更改生效。

以下是我正在使用的代码：

$scope.checking = function(arg){
  return $http.post('path/');
}

您可以提供的任何帮助将非常感谢!!这几个星期以来，我一直在用头撞墙！

Answer 1

经过一番广泛的研究，我找到了我想要的答案。我已在此处发布，以防任何人遇到类似情况。

我遇到的主要问题是通过关闭工作簿或不得不进入打印首选项并单击重置来获得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

Answer 2

太棒了。感谢您的修复。我们的办公室最近切换到了Windows 10和Office 16，而我原来的双工代码不再适用于以双工模式打印工作表。您的代码非常复杂，但是它可以工作（由于我作为新手程序员所无法理解的原因），并且可以节省大量纸张，避免浪费。非常感谢你。我确实注意到您的功能需要解决的一件事。调用了另一个您未提供的功能。

sPrinter = GetPrinterFullName("CutePDF")

巧合的是，我碰巧在另一个模块中具有函数GetPrinterFullName（），因此它正在运行，但未返回“ CutePDF”的全名。那是因为我的计算机上不存在“ CutePDF”。因此，我只是进入设置，将默认设置设置为“ Microsoft Print to PDF”，然后进行了一个小的测试例程（如下）以获取活动默认打印机的全名：

sub getActivePrinterFullAddress()
    debug.print application.activeprinter
end sub

这返回“ Ne03上的Microsoft Print to PDF：”，因此任何用户都可以通过添加第3个变量来避免将第二台打印机的全名发送给您的函数，而避免调用GetPrinterFullName（），否则他们可以对名称进行硬编码就像我为避免调用所做的那样进入您的函数。或者，他们可以在模块中添加以下功能：（今天早上我去过30个不同的站点，找到一种解决方案，而您的方法是可行的。但是，以下功能的功劳在下面的功能内。不是我的代码。我认为这应该归功于Frans Bus）

Public Function GetPrinterFullName(Printer As String) As String

' This function returns the full name of the first printerdevice that
   matches Printer.
' Full name is like "PDFCreator on Ne01:" for a English Windows and like
' "PDFCreator sur Ne01:" for French.
' Created: Frans Bus, 2015. See http://pixcels.nl/set-activeprinter-excel
' see http://blogs.msdn.com/b/alejacma/archive/2008/04/11/how-to-read-a-
  registry-key-and-its-values.aspx
' see http://www.experts-exchange.com/Software/Microsoft_Applications/Q_27566782.html

Const HKEY_CURRENT_USER = &H80000001
Dim regobj As Object
Dim aTypes As Variant
Dim aDevices As Variant
Dim vDevice As Variant
Dim sValue As String
Dim v As Variant
Dim sLocaleOn As String

' get locale "on" from current activeprinter
v = Split(Application.ActivePrinter, Space(1))
sLocaleOn = Space(1) & CStr(v(UBound(v) - 1)) & Space(1)

' connect to WMI registry provider on current machine with current user
Set regobj = GetObject("WINMGMTS:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")

' get the Devices from the registry
regobj.EnumValues HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", aDevices, aTypes

' find Printer and create full name
For Each vDevice In aDevices
    ' get port of device
    regobj.GetStringValue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", vDevice, sValue
    ' select device
    If Left(vDevice, Len(Printer)) = Printer Then ' match!
        ' create localized printername
        GetPrinterFullName = vDevice & sLocaleOn & Split(sValue, ",")(1)
        Exit Function
    End If
Next

' at this point no match found
GetPrinterFullName = vbNullString

End Function

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

2 个答案: