打印文件时指定打印机

Question

我有一个宏可以打印特定文件夹中的所有文件，但每次打开文件时都会询问从哪个打印机打印。

我想输入打印机名称或 IP，而不是询问用户或使用默认打印机。

Sub PrintDespatches()
Dim wb As Workbook, ws As Worksheet
Dim FileName As String, path As String
Set wb = ActiveWorkbook
Set ws = ActiveSheet

path = "Z:\Customer Operations\2021\Despatches\*.csv"

FileName = Dir(path, vbNormal)
Do Until FileName = ""
    Application.DisplayAlerts = False
    Application.Dialogs(xlDialogPrinterSetup).Show
    Workbooks.Open Left(path, Len(path) - 5) & FileName
    Columns("A:H").AutoFit
    With ActiveSheet.PageSetup
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    Set wb = ActiveWorkbook
    For Each ws In wb.Worksheets
        ws.PrintOut
    Next
    wb.Close
    FileName = Dir()
Loop
End Sub

我尝试将Application.Dialogs(xlDialogPrinterSetup).Show 替换为mynetwork.setdefaultprinter "Your Printer Name"。

Answer 1

请尝试使用：

Application.ActivePrinter = "Microsoft Print to PDF on Ne02:" 'use here your printer

但是写一个字符串是不够的，你可以在“打印机和扫描仪”中看到打印机名称。

A.您首先需要枚举所有已安装的打印机并使用确切的字符串，包括端口。

B.或者，更简单的是，您可以通过使用打印机设置对话框打印一些内容，选择您需要的打印机并使用简单的代码行获取它：

Debug.Print Application.ActivePrinter

然后，使用返回的打印机名称...

为了以 Excel 能够使用其名称的方式返回所有已安装的打印机，这有点复杂。但是，如果您想要/需要它，请尝试下一种方法：

1. 将下一个 API 函数声明和常量复制到标准模块之上（在声明区域中）：

Option Explicit

Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const HKCU = HKEY_CURRENT_USER
Private Const KEY_QUERY_VALUE = &H1&
Private Const ERROR_NO_MORE_ITEMS = 259&
Private Const ERROR_MORE_DATA = 234

#If VBA7 Then
    #If Win64 Then
        Declare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" Alias _
           "RegOpenKeyExA" (ByVal hKey As LongPtr, ByVal lpSubKey As String, _
            ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As LongPtr) As Long
        
        Declare PtrSafe Function RegEnumValue Lib "advapi32.dll" Alias _
           "RegEnumValueA" (ByVal hKey As LongPtr, ByVal dwIndex As Long, _
           ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As LongPtr, _
                                     lpType As Long, lpData As Byte, lpcbData As Long) As Long
                                     
        Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As LongPtr) As Long
        Declare PtrSafe Function RegConnectRegistry Lib "advapi32.dll" Alias "RegConnectRegistryA" _
                (ByVal lpMachineName As String, ByVal hKey As LongPtr, phkResult As LongPtr) As Long
    #Else
        Private Declare Function RegOpenKeyEx Lib "advapi32" _
            Alias "RegOpenKeyExA" ( _
            ByVal hKey As Long, _
            ByVal lpSubKey As String, _
            ByVal ulOptions As Long, _
            ByVal samDesired As Long, _
            phkResult As Long) As Long
        
        Private Declare Function RegEnumValue Lib "advapi32.dll" _
            Alias "RegEnumValueA" ( _
            ByVal hKey As Long, _
            ByVal dwIndex As Long, _
            ByVal lpValueName As String, _
            lpcbValueName As Long, _
            ByVal lpReserved As Long, _
            lpType As Long, _
            lpData As Byte, _
            lpcbData As Long) As Long
        
        Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
            ByVal hKey As Long) As Long
    #End If
#Else
    Private Declare Function RegOpenKeyEx Lib "advapi32" _
        Alias "RegOpenKeyExA" ( _
        ByVal hKey As Long, _
        ByVal lpSubKey As String, _
        ByVal ulOptions As Long, _
        ByVal samDesired As Long, _
        phkResult As Long) As Long
        
    Private Declare Function RegEnumValue Lib "advapi32.dll" _
        Alias "RegEnumValueA" ( _
        ByVal hKey As Long, _
        ByVal dwIndex As Long, _
        ByVal lpValueName As String, _
        lpcbValueName As Long, _
        ByVal lpReserved As Long, _
        lpType As Long, _
        lpData As Byte, _
        lpcbData As Long) As Long
        
    Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
        ByVal HKey As Long) As Long#End If
#End If

1. 在同一模块中复制下一个函数：

    

Public Function GetPrinterFullNames() As String()
Dim Printers() As String ' array of names to be returned
Dim PNdx As Long         ' index into Printers()
#If Win64 Then
    Dim hKey As LongPtr  ' registry key handle
#Else
    Dim hKey As Long     ' registry key handle
#End If
    
Dim res As Long          ' result of API calls
Dim Ndx As Long          ' index for RegEnumValue
Dim ValueName As String  ' name of each value in the printer key
Dim ValueNameLen As Long    ' length of ValueName
Dim DataType As Long        ' registry value data type
Dim ValueValue() As Byte    ' byte array of registry value value
Dim ValueValueS As String   ' ValueValue converted to String
Dim CommaPos As Long        ' position of comma character in ValueValue
Dim ColonPos As Long        ' position of colon character in ValueValue
Dim M As Long               ' string index

' registry key in HCKU listing printers
Const PRINTER_KEY = "Software\Microsoft\Windows NT\CurrentVersion\Devices"

PNdx = 0
Ndx = 0
' assume printer name is less than 256 characters
ValueName = String$(256, Chr(0))
ValueNameLen = 255
' assume the port name is less than 1000 characters
ReDim ValueValue(0 To 999)
' assume there are less than 1000 printers installed
ReDim Printers(1 To 1000)

' open the key whose values enumerate installed printers
res = RegOpenKeyEx(HKCU, PRINTER_KEY, 0&, _
                            KEY_QUERY_VALUE, hKey)
' start enumeration loop of printers
res = RegEnumValue(hKey, Ndx, ValueName, _
    ValueNameLen, 0&, DataType, ValueValue(0), 1000)
' loop until all values have been enumerated
Do Until res = ERROR_NO_MORE_ITEMS
    M = InStr(1, ValueName, Chr(0))
    If M > 1 Then
        ' clean up the ValueName
        ValueName = left(ValueName, M - 1)
    End If
    ' find position of a comma and colon in the port name
    CommaPos = InStr(1, ValueValue, ",")
    ColonPos = InStr(1, ValueValue, ":")
    ' ValueValue byte array to ValueValueS string
    On Error Resume Next
    ValueValueS = Mid(ValueValue, CommaPos + 1, ColonPos - CommaPos)
    On Error GoTo 0
    ' next slot in Printers
    PNdx = PNdx + 1
    Printers(PNdx) = ValueName & " on " & ValueValueS
    ' reset some variables
    ValueName = String(255, Chr(0))
    ValueNameLen = 255
    ReDim ValueValue(0 To 999)
    ValueValueS = vbNullString
    ' tell RegEnumValue to get the next registry value
    Ndx = Ndx + 1
    ' get the next printer
    res = RegEnumValue(hKey, Ndx, ValueName, ValueNameLen, _
        0&, DataType, ValueValue(0), 1000)
    ' test for error
    If (res <> 0) And (res <> ERROR_MORE_DATA) Then
        Exit Do
    End If
Loop
' shrink Printers down to used size
ReDim Preserve Printers(1 To PNdx)
res = RegCloseKey(hKey)
' Return the result array
GetPrinterFullNames = Printers
End Function

1. 您需要使用上述代码一次，以便在 Excel 需要时接收已安装的打印机名称（包括端口）。复制下一个测试子：

Sub TestEnumPrinters()
    Dim Printers() As String, n As Long, S As String
    Printers = GetPrinterFullNames()
    For n = LBound(Printers) To UBound(Printers)
        Debug.Print Printers(n) ', left(Printers(n), InStr(Printers(n), " on "))
    Next n
End Sub

4. 现在使用返回的打印机名称并设置要使用的打印机：

Application.ActivePrinter = "My printer ... on Ne0x:"