打印文件时指定打印机 [英] Specify Printer when Printing Files

问题描述

我有一个宏，可以打印特定文件夹中的所有文件，但是每次打开文件时，它都会询问要从哪台打印机进行打印.

I have a macro that prints all files within a specific folder but each time it opens a file it asks which printer to print from.

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

I want to enter the printer name or IP instead of asking the user or using the default printer.

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您的打印机名称" .

推荐答案

请尝试使用:

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

但是仅写一个字符串是不够的，因为您可以在打印机和打印机"中看到打印机名称.扫描仪的.

But it is not enough to write a string as you can see the printer name in 'Printers & Scanners'.

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

A. You firstly need to enumerate all installed printers and use the exact string, including the port, too.

B.或者，更简单地说，您可以通过使用打印机设置"对话框进行打印，选择所需的打印机并使用简单的代码行来获取它来完成此操作:

B. Or, simpler, you can do that by printing something using the printers Setup dialog, choosing the printer you need and getting it using a simple code line:

Debug.Print Application.ActivePrinter

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

Then, use the returned printer name...

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

In order to return all installed printers in the way Excel is able to use their names, it is a little more complicated. But, if you want/need it, try the next approach, please:

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:

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

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

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

这篇关于打印文件时指定打印机的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！