如何仅用VBA实现自定义程序报表转Microsoft Print to PDF自动化？

当然可以仅用VBA实现这个步骤！既然你已经用UIAutomation完成了报表生成的自动化，我们可以把打印到PDF的逻辑直接整合到现有代码中，不需要额外安装语言包或引用。下面是具体的实现方案，结合你现有的代码进行扩展：

核心思路 #

我们会通过UIAutomation定位打印对话框元素（比单纯用SendKeys更稳定），完成以下操作：

• 触发打印快捷键Ctrl+P
• 选择「Microsoft Print to PDF」打印机
• 在保存对话框中指定目标路径和文件名
• 完成保存

扩展后的完整代码 #

Sub open_evol()
 Dim oUIAutomation As New CUIAutomation8
 Dim oUIADesktop As IUIAutomationElement
 Dim allChilds As IUIAutomationElementArray
 Dim allChildsAxys As IUIAutomationElementArray
 Dim axys As IUIAutomationElement
 Dim axys2 As IUIAutomationElement
 Dim intermed As IUIAutomationElement
 Dim boxes As IUIAutomationElementArray
 Dim boxes2 As IUIAutomationElementArray
 Dim a As IUIAutomationElement
 Dim printDialog As IUIAutomationElement
 Dim saveDialog As IUIAutomationElement
 Dim printerCombo As IUIAutomationElement
 Dim printBtn As IUIAutomationElement
 Dim savePathEdit As IUIAutomationElement
 Dim saveBtn As IUIAutomationElement
 Dim time1 As Date, time2 As Date
 
 ' --- 你的原有报表生成代码 ---
 Set oUIADesktop = oUIAutomation.GetRootElement
 Debug.Print oUIADesktop.CurrentName
 Set allChilds = oUIADesktop.FindAll(TreeScope_Children, oUIAutomation.CreateTrueCondition)
 For i = 0 To allChilds.Length - 1
 Debug.Print i & ":=" & allChilds.GetElement(i).CurrentName & vbTab & allChilds.GetElement(i).CurrentClassName
 If Left(allChilds.GetElement(i).CurrentName, 12) = "Axys Reports" Then
 Set axys = allChilds.GetElement(i)
 End If
 Next
 On Error GoTo escape:
 axys.SetFocus
 On Error GoTo 0
 SendKeys "%cee~", True
 time1 = Now
 time2 = Now + TimeValue("0:00:01")
 Do Until time1 >= time2
 DoEvents
 time1 = Now()
 Loop
 Set allChildsAxys = axys.FindAll(TreeScope_Children, oUIAutomation.CreateTrueCondition)
 Set axys2 = allChildsAxys.GetElement(0)
 Set boxes = axys2.FindAll(TreeScope_Element, oUIAutomation.CreateTrueCondition)
 For i = 0 To boxes.Length - 1
 If Left(boxes.GetElement(i).CurrentName, 8) = "Evol e R" Then
 Set intermed = boxes.GetElement(i)
 Debug.Print "intermet: "; boxes.GetElement(i).CurrentName
 End If
 Next i
 Set boxes2 = intermed.FindAll(TreeScope_Subtree, oUIAutomation.CreateTrueCondition)
 boxes2.GetElement(4).SetFocus
 SendKeys "+^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT} +^{LEFT}", True
 SendKeys "{DELETE}", True
 SendKeys "@5ABE2", True
 boxes2.GetElement(9).SetFocus
 SendKeys "^{RIGHT} +^{LEFT}", True
 SendKeys "{DELETE}", True
 SendKeys "033118", True
 boxes2.GetElement(13).SetFocus
 SendKeys "^{RIGHT} +^{LEFT}", True
 SendKeys "{DELETE}", True
 SendKeys "043018", True
 boxes2.GetElement(26).SetFocus
 SendKeys "{ENTER}"
 
 ' --- 新增：打印到PDF的自动化逻辑 ---
 ' 等待报表加载完成（可根据实际情况调整等待时间）
 time1 = Now
 time2 = Now + TimeValue("0:00:03")
 Do Until time1 >= time2
 DoEvents
 time1 = Now()
 Loop
 
 ' 触发打印对话框
 axys.SetFocus
 SendKeys "^p", True
 
 ' 等待打印对话框出现
 Do
 Set printDialog = oUIAutomation.ElementFromHandle(FindWindow(vbNullString, "Print"))
 DoEvents
 Loop Until Not printDialog Is Nothing
 
 ' 定位打印机下拉框（类名：ComboBox）
 Set printerCombo = printDialog.FindFirst(TreeScope_Subtree, oUIAutomation.CreatePropertyCondition(UIA_ClassNamePropertyId, "ComboBox"))
 If Not printerCombo Is Nothing Then
 printerCombo.SetFocus
 ' 选择Microsoft Print to PDF（发送下拉快捷键+输入名称）
 SendKeys "%{DOWN}", True
 SendKeys "Microsoft Print to PDF", True
 SendKeys "{ENTER}", True
 End If
 
 ' 定位打印按钮并点击
 Set printBtn = printDialog.FindFirst(TreeScope_Subtree, oUIAutomation.CreatePropertyCondition(UIA_NamePropertyId, "Print"))
 If Not printBtn Is Nothing Then
 Dim invokePattern As IUIAutomationInvokePattern
 Set invokePattern = printBtn.GetCurrentPattern(UIA_InvokePatternId)
 invokePattern.Invoke
 End If
 
 ' 等待保存对话框出现
 Do
 Set saveDialog = oUIAutomation.ElementFromHandle(FindWindow(vbNullString, "Save Print Output As"))
 DoEvents
 Loop Until Not saveDialog Is Nothing
 
 ' 定位路径输入框并指定保存路径（替换成你的目标路径）
 Set savePathEdit = saveDialog.FindFirst(TreeScope_Subtree, oUIAutomation.CreatePropertyCondition(UIA_ClassNamePropertyId, "Edit"))
 If Not savePathEdit Is Nothing Then
 savePathEdit.SetFocus
 SendKeys "^a", True ' 全选现有内容
 SendKeys "C:\Your\Target\Directory\Report_033118_to_043018.pdf", True ' 替换为你的指定路径和文件名
 End If
 
 ' 点击保存按钮
 Set saveBtn = saveDialog.FindFirst(TreeScope_Subtree, oUIAutomation.CreatePropertyCondition(UIA_NamePropertyId, "Save"))
 If Not saveBtn Is Nothing Then
 Set invokePattern = saveBtn.GetCurrentPattern(UIA_InvokePatternId)
 invokePattern.Invoke
 End If
 
escape:
 MsgBox ("报表生成并保存为PDF完成！")
End Sub

关键注意事项 #

• 等待时间调整：代码中的等待时间（如TimeValue("0:00:03")）需要根据你的报表加载速度调整，确保报表完全生成后再触发打印。
• 元素定位兼容性：不同Windows版本的对话框元素类名/名称可能略有差异，如果运行时找不到元素，建议用Debug.Print输出对话框的子元素信息，调整定位条件。
• 路径格式：保存路径要使用绝对路径，且文件名不能包含特殊字符（如/ \ : * ? " < > |）。
• UIAutomation依赖：确保你的VBA项目已经引用了Microsoft UI Automation 5.0或更高版本（在VBA编辑器的「工具」→「引用」中勾选）。

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