Excel VBA 带滚动条UserForm打印并保存为指定路径PDF的解决方案问询

你需要的带滚动条UserForm自动打印、重命名保存到指定路径PDF的功能完全可以实现，核心实现逻辑为调用Windows系统自带的Microsoft Print to PDF虚拟打印机，无需截屏即可完整输出UserForm全部内容，同时支持自定义输出路径和文件名。

修改后完整代码 #

Option Explicit
Private Const HWND_BROADCAST As Long = &HFFFF&
Private Const WM_WININICHANGE As Long = &H1A
 
Private Declare PtrSafe Sub keybd_event Lib "user32" _
(ByVal bVk As Byte, ByVal bScan As Byte, _
ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)

Private Declare PtrSafe Function SendNotifyMessage Lib "user32" Alias "SendNotifyMessageA" ( _
  ByVal hwnd As LongPtr, _
  ByVal Msg As Long, _
  ByVal wParam As Long, _
  lParam As Any) As Long
 
Private Declare PtrSafe Function SetDefaultPrinter Lib "winspool.drv" Alias "SetDefaultPrinterA" ( _
  ByVal pszPrinter As String) As Long
 
Public Sub ChangePrinter(NewPrinter As String)
  SetDefaultPrinter NewPrinter
  Call SendNotifyMessage(HWND_BROADCAST, _
    WM_WININICHANGE, _
    0, ByVal "windows")
End Sub

Private Sub btn_Print_Click()
    Dim OldPrinter As String
    Dim sSaveFolder As String, sFileName As String, sFullPath As String
    Dim oPrinters As Printer
    Dim bPDFPrinterExist As Boolean
    
    ' 校验Microsoft Print to PDF打印机是否存在
    bPDFPrinterExist = False
    For Each oPrinters In Application.Printers
        If InStr(1, oPrinters.DeviceName, "Microsoft Print to PDF", vbTextCompare) > 0 Then
            bPDFPrinterExist = True
            Exit For
        End If
    Next
    If Not bPDFPrinterExist Then
        MsgBox "未检测到Microsoft Print to PDF打印机，请先在Windows功能中开启该功能", vbCritical
        Exit Sub
    End If
    
    ' 配置存储路径与文件名，此处可自行修改
    sSaveFolder = "C:\Users\user\Documents\Almadina Related\NHIS RELATED\" ' 注意路径末尾必须加反斜杠\
    sFileName = Me.txt_pNameDefaultclaimsForm.Value & ".pdf"
    
    ' 过滤文件名中的非法字符，避免保存失败
    Dim arrIllegalChars As Variant, i As Integer
    arrIllegalChars = Array("\", "/", ":", "*", "?", """", "<", ">", "|")
    For i = LBound(arrIllegalChars) To UBound(arrIllegalChars)
        sFileName = Replace(sFileName, arrIllegalChars(i), "")
    Next
    sFullPath = sSaveFolder & sFileName
    
    ' 记录当前默认打印机，后续切换回
    OldPrinter = Left(Application.ActivePrinter, InStrRev(Application.ActivePrinter, "on ") - 2)
    
    On Error GoTo ErrHandler
    ' 切换默认打印机为PDF虚拟打印机
    ChangePrinter "Microsoft Print to PDF"
    
    ' 模拟输入保存路径，自动确认保存
    SendKeys sFullPath & "{ENTER}", False
    ' 打印UserForm全部内容（含滚动区域）
    Me.PrintForm
    
    ' 切换回原默认打印机
    ChangePrinter OldPrinter
    MsgBox "PDF已成功保存至：" & sFullPath, vbInformation
    Exit Sub
    
ErrHandler:
    MsgBox "保存失败，错误信息：" & Err.Description, vbCritical
    ' 出错时强制切回原打印机，避免影响系统默认打印设置
    ChangePrinter OldPrinter
    Unload Me
End Sub

配置与使用说明 #

• 首先开启系统PDF打印功能：打开「控制面板」→「程序」→「启用或关闭Windows功能」，找到并勾选「Microsoft Print to PDF」，确认后等待功能安装完成即可。
• 代码中sSaveFolder变量请修改为你实际的存储文件夹，务必保证路径末尾添加反斜杠\。
• 只要你的UserForm的ScrollHeight属性已正确设置为内容总高度，PrintForm命令会自动输出全部滚动区域内容，不会仅输出当前可见区域。
• 执行打印操作时请不要操作键盘鼠标，避免SendKeys输入焦点偏移导致保存失败。

内容的提问来源于stack exchange，提问作者Israel