在Word 2010中,我尝试创建一个宏,将当前打印机设置为我们网络上的特定彩色打印机,而不将该打印机设置为用户的系统默认打印机。我已经从网上找到的示例中将一些代码整理到一起。一切正常,但SetColorPrinterEast Sub改变了用户的系统默认打印机,这是我不想要的。我怀疑该子目录中的DoNotSetAsSysDefault没有按预期工作,但我不知道如何处理它。请参阅代码中的注释以获得进一步说明。任何想法将不胜感激。在此先感谢!!!
'I found the code block below on the web. I don't understand it, but
'it seems to work properly with the "SetDefaultPrinter"
'Sub below to get the system default printer.
Public Declare Function GetProfileString Lib "kernel32" _
Alias "GetProfileStringA" _
(ByVal lpAppName As String, _
ByVal lpKeyName As String, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long) As Long
' This code successfully sets the document to print from
' the system default printer.
Public Sub SetDefaultPrinter()
Dim strReturn As String
Dim intReturn As Integer
strReturn = Space(255)
intReturn = GetProfileString("Windows", ByVal "device", "", _
strReturn, Len(strReturn))
If intReturn Then
strReturn = UCase(Left(strReturn, InStr(strReturn, ",") - 1))
End If
With Dialogs(wdDialogFilePrintSetup)
.Printer = strReturn
.DoNotSetAsSysDefault = True
.Execute
End With
End Sub
' This code correctly sets the printer to a specific color printer
' on our network. The problem is that it makes that printer
' the user's system default printer. I would think that the
' .DoNotSetAsSysDefault = True line would solve this problem
' but still this sub changes the user's system default printer.
Public Sub SetColorPrinterEast()
With Dialogs(wdDialogFilePrintSetup)
.Printer = "\\[*NETWORK PATH*]\Color Printer East"
.DoNotSetAsSysDefault = True
.Execute
End With
End Sub
答案 0 :(得分:1)
几年前我遇到了同样的问题,通过将当前默认打印存储在变量中,将默认打印机更改为我需要的打印机,打印,然后将默认打印机更改回用户原始默认值来解决问题。 / p>
这是为Word 2003设计和编写的,但在Word 2010中继续有效。
以下是我使用的具体代码:
'Define Printer to add and printer to delete
Const PrintPath = "\\prn001l0003\Colour04"
Const PrintDeletePath = "\\prn001l0003\Colour02"
' Used to see what printers are set up on the user, and to set a new network printer
Public Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" (ByVal flags As Long, ByVal name As String, _
ByVal Level As Long, pPrinterEnum As Long, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
Public Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyA" (ByVal RetVal As String, ByVal Ptr As Long) As Long
Public Declare Function StrLen Lib "kernel32" Alias "lstrlenA" (ByVal Ptr As Long) As Long
Const PRINTER_ENUM_CONNECTIONS = &H4
Const PRINTER_ENUM_LOCAL = &H2
Public Sub PrintLetter(ByRef LetterBrochures() As String)
'Print the document
Dim STDprinter As String
On Error Resume Next
Call CheckPrinterLoaded ' Get users loaded printers, remove any old printers used here,
' and add printer I want to users printers
STDprinter = Application.ActivePrinter ' store the current default printer
Application.ActivePrinter = PrintPath ' change default printer to want I want
On Error GoTo printLetterError
Application.DisplayAlerts = wdAlertsNone ' prevent Word showing any alert/warnings etc
With ActiveDocument ' first page is letterhead from tray 2, all others from tray 1, print
.PageSetup.FirstPageTray = 3 ' 3 = Tray 2 on MFLaser
.PageSetup.OtherPagesTray = 1 ' 1 = Tray 1 on MFLaser
.PrintOut Background:=False
End With
Application.DisplayAlerts = wdAlertsAll ' enable Word alets/warning etc
Application.ActivePrinter = STDprinter 'change back users default printer
Exit Sub
printLetterError:
MsgBox "Error printing letter" & vbCrLf & Err.Number & vbCrLf & Err.Description, vbCritical, "Error"
ActiveDocument.Close False
End
End Sub
Public Function CheckPrinterLoaded()
'get users printers
'look for and delete defined printer, PrintDeletePath
'add printer I want to users printers, PrintPath
Dim StrPrinters As Variant, x As Long
Dim StrSetPrinter As String
Dim objNetwork
Set objNetwork = CreateObject("WScript.Network")
StrPrinters = ListPrinters
'Fist check whether the array is filled with anything, by calling another function, IsBounded.
If IsBounded(StrPrinters) Then
For x = LBound(StrPrinters) To UBound(StrPrinters)
If StrPrinters(x) = PrintDeletePath Then
objNetwork.RemovePrinterConnection PrintDeletePath
End If
Next x
objNetwork.AddWindowsPrinterConnection PrintPath
Else
MsgBox "No printers found"
End If
End Function
Private Function ListPrinters() As Variant
Dim bSuccess As Boolean
Dim iBufferRequired As Long
Dim iBufferSize As Long
Dim iBuffer() As Long
Dim iEntries As Long
Dim iIndex As Long
Dim strPrinterName As String
Dim iDummy As Long
Dim iDriverBuffer() As Long
Dim StrPrinters() As String
iBufferSize = 3072
ReDim iBuffer((iBufferSize \ 4) - 1) As Long
'EnumPrinters will return a value False if the buffer is not big enough
bSuccess = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or PRINTER_ENUM_LOCAL, vbNullString, 1, iBuffer(0), iBufferSize, iBufferRequired, iEntries)
If Not bSuccess Then
If iBufferRequired > iBufferSize Then
iBufferSize = iBufferRequired
Debug.Print "iBuffer too small. Trying again with "; iBufferSize & " bytes."
ReDim iBuffer(iBufferSize \ 4) As Long
End If
'Try again with new buffer
bSuccess = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or PRINTER_ENUM_LOCAL, vbNullString, 1, iBuffer(0), iBufferSize, iBufferRequired, iEntries)
End If
If Not bSuccess Then
'Enumprinters returned False
MsgBox "Error enumerating printers."
Exit Function
Else
'Enumprinters returned True, use found printers to fill the array
ReDim StrPrinters(iEntries - 1)
For iIndex = 0 To iEntries - 1
'Get the printername
strPrinterName = Space$(StrLen(iBuffer(iIndex * 4 + 2)))
iDummy = PtrToStr(strPrinterName, iBuffer(iIndex * 4 + 2))
StrPrinters(iIndex) = strPrinterName
Next iIndex
End If
ListPrinters = StrPrinters
End Function
Private Function IsBounded(vArray As Variant) As Boolean
'If the variant passed to this function is an array, the function will return True; otherwise it will return False
On Error Resume Next
IsBounded = IsNumeric(UBound(vArray))
End Function