请求协助编写VBA代码实现Excel图表转PPT并添加打印按钮

以下是完整的VBA代码，实现将指定Excel工作表中的图表批量复制到新建的PowerPoint演示文稿，并在每张幻灯片添加打印按钮，点击可打印当前幻灯片：

Sub ExcelChartsToPPTWithPrintButton()
    Dim pptApp As Object
    Dim pptPres As Object
    Dim pptSlide As Object
    Dim excelChart As ChartObject
    Dim printBtn As Object
    Dim ws As Worksheet
    
    ' 设置要导出图表的工作表，可根据实际修改
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 启动PowerPoint，若已打开则直接使用
    On Error Resume Next
    Set pptApp = GetObject(, "PowerPoint.Application")
    On Error GoTo 0
    
    If pptApp Is Nothing Then
        Set pptApp = CreateObject("PowerPoint.Application")
    End If
    pptApp.Visible = True
    
    ' 创建新演示文稿
    Set pptPres = pptApp.Presentations.Add
    
    ' 遍历工作表中的所有图表
    For Each excelChart In ws.ChartObjects
        ' 添加新幻灯片（使用标题+内容版式）
        Set pptSlide = pptPres.Slides.Add(pptPres.Slides.Count + 1, ppLayoutTitleAndContent)
        
        ' 设置幻灯片标题为图表名称
        pptSlide.Shapes(1).TextFrame.TextRange.Text = excelChart.Name
        
        ' 复制Excel图表并粘贴到幻灯片内容区域
        excelChart.Copy
        pptSlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
        
        ' 调整图表位置（可根据需求修改坐标和尺寸）
        With pptSlide.Shapes(pptSlide.Shapes.Count)
            .Top = 100
            .Left = 50
            .Width = 600
            .Height = 400
        End With
        
        ' 添加打印按钮到幻灯片
        Set printBtn = pptSlide.Shapes.AddFormControl(Type:=msoControlButton, _
                                                     Left:=650, Top:=500, Width:=100, Height:=30)
        With printBtn
            .Caption = "打印此页"
            ' 绑定打印宏
            .OnAction = "PrintCurrentSlide"
        End With
    Next excelChart
    
    ' 在PowerPoint中添加打印宏模块
    AddPrintMacroToPPT pptPres
    
    MsgBox "图表已全部导入PowerPoint，打印按钮已添加完成！", vbInformation
End Sub

Sub AddPrintMacroToPPT(pptPres As Object)
    Dim vbaModule As Object
    Dim macroCode As String
    
    ' 创建新模块
    Set vbaModule = pptPres.VBProject.VBComponents.Add(vbext_ct_StdModule)
    
    ' 打印当前幻灯片的宏代码
    macroCode = "Sub PrintCurrentSlide()" & vbCrLf & _
                "    ActiveWindow.View.Slide.PrintOut" & vbCrLf & _
                "End Sub"
    
    ' 将代码写入模块
    vbaModule.CodeModule.AddFromString macroCode
End Sub

关键说明 #

• 引用PowerPoint对象库：若运行时提示"找不到对象"，需打开VBA编辑器（Alt+F11），依次点击工具→引用，勾选Microsoft PowerPoint xx.x Object Library（xx.x为你的PowerPoint版本）。
• 工作表修改：代码中ws = ThisWorkbook.Worksheets("Sheet1")需替换为你存放图表的工作表名称。
• 图表与按钮位置：可修改代码中.Top、.Left、.Width、.Height参数调整图表和按钮的显示位置与尺寸。
• 错误处理：代码中已处理PowerPoint未启动的情况，若仍报错，检查是否启用了PowerPoint的宏功能。

使用步骤 #

1. 打开包含图表的Excel文件，按Alt+F11打开VBA编辑器。
2. 插入模块（插入→模块），粘贴上述代码。
3. 根据实际情况修改工作表名称和位置参数。
4. 运行ExcelChartsToPPTWithPrintButton宏即可完成操作。

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