将默认打印机设置为Microsoft打印为PDF [英] Setting Default Printer to Microsoft Print to PDF

问题描述

我目前正在使用vba宏填写pdf表格并将其打印为另一个pdf.如果"Microsoft Print to PDF"是默认打印机，则此方法工作正常，但是我确实需要不时更改此设置，而忘记将其更改回.我目前正在下面的另一个宏上使用此代码，以将默认打印机更改为办公室中的实际纸张打印机.但是，当我将其与Microsoft Print to PDF打印机一起使用时，它可以运行，但不会更改默认打印机.

I am currently using a vba macro to fill in a pdf form and print it to another pdf. This works fine if the 'Microsoft Print to PDF' is the default printer however I do need to change this from time to time and forget to change it back. I am currently using this code below on another macro to change the default printer to an actual paper printer in the office; however, when I use this with the Microsoft Print to PDF printer it runs but does not change the default printer.

CreateObject("WScript.Network").SetDefaultPrinter "Microsoft Print to PDF"

推荐答案

如果在Windows 10中运行，则默认使用特殊"功能.设置默认使用的上次使用打印机的方式.

If working in Windows 10, it has a default "special" way of setting the last used printer like default.

如果您需要手动设置默认打印机，请执行以下操作:

If you need to manually set the default printer, please do the next:

转到设置->设备->打印机和扫描器，向下滚动并取消选中让Windows管理我的默认打印机".

Go Settings -> Devices -> Printers & Scanners, scroll down and un-check "Let Windows manage my default printer".

除了您的代码外，VBA还具有与打印机打交道的方式:

Besides your code, VBA has its own way of dealing with printers:

尝试:

Debug.Print Application.ActivePrinter 'it will return the default printer name

手动将所需的打印机设置为默认打印机，它将返回"Microsoft打印到Nexx上的PDF"之类的内容.使用此名称将其设置为默认名称:

Manually set your wished printer as default and it will return something like "Microsoft Print to PDF on Nexx". Use this name to set it as default:

Application.ActivePrinter = "Microsoft Print to PDF on Nexx"

您可以使用以下代码接收所有已安装打印机的列表(采用上述格式):

You can use this code to receive the list of all installed printers (in the above format):

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
    

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
    If ColonPos > CommaPos Then
        On Error Resume Next
         ValueValueS = Mid(ValueValue, CommaPos + 1, ColonPos - CommaPos)
        On Error GoTo 0
    Else
        ValueValueS = "nul:"
    End If
    ' 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

您可以通过以下方式使用它:

And you can use it in the next way:

Sub TestEnumPrinters()
    Dim Printers() As String, n As Long
    Printers = GetPrinterFullNames()
    For n = LBound(Printers) To UBound(Printers)
        Debug.Print Printers(n)
    Next n
End Sub

从立即窗口中获取Windows 10打印机名称...

Take the Windows 10 printer name from the Immediate Window...

这篇关于将默认打印机设置为Microsoft打印为PDF的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！