将 Excel 仪表板导出到 PowerPoint

Question

我正在尝试基于 Excel 文件和用户输入创建 PPT 生成器。到目前为止，我设法创建了用户表单，用户正在定义他想在演示文稿中看到的 Excel 报告（图表加表格）。为了定义选择了哪个报告，我使用了全局变量。现在，当我尝试生成演示文稿时，出现错误：“运行时错误'-2147023170(800706b3)'：自动化错误。远程过程调用失败。”调试显示行newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutTitleOnly 因为我使用函数 For 检查是否选择了报告（基于我的全局变量），所以我有多行这样的行，如果是，则为每个报告重复代码。 下面是代码本身。我不确定我做错了什么。

Sub CreatePowerPoint()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'declare the variables
    Dim newPowerPoint As PowerPoint.Application
    Dim activeSlide As PowerPoint.Slide
    Dim cht As Excel.ChartObject
    Dim This As Workbook
    Set This = ActiveWorkbook

 'look for existing instance
    On Error Resume Next
    Set newPowerPoint = GetObject(, "PowerPoint.Application")
    On Error GoTo 0

 'create a new PowerPoint
    If newPowerPoint Is Nothing Then
        Set newPowerPoint = New PowerPoint.Application
    End If
        newPowerPoint.Presentations.Add
        newPowerPoint.Visible = True

 'TBA Starting Slides/Agenda
       *Code here*


'Check if report was selected, if yes perform addition of new slides with graphs and tables

If CB1 = 1 Then
This.Worksheets("Coverage Summary").Select
    For Each cht In ActiveSheet.ChartObjects

    'Add a new slide
        newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutTitleOnly
        newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
        Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)

    'Copy the chart and paste it into the PP
        cht.Select
        ActiveChart.ChartArea.Copy
        activeSlide.Shapes.PasteSpecial(DataType:=ppPasteChartObject).Select

    'Set the title of the slide
        activeSlide.Shapes(1).TextFrame.TextRange.Text = "Coverage Summary" 

    'Adjust the positioning
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 15
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 125

    Next
Set activeSlide = Nothing
End If

If CB2 = 1 Then
This.Worksheets("Additions Report").Select
    For Each cht In ActiveSheet.ChartObjects

    'Add a new slide
        newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutTitleOnly
        newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
        Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)

    'Copy the chart and paste it into the PP
        cht.Select
        ActiveChart.ChartArea.Copy
        activeSlide.Shapes.PasteSpecial(DataType:=ppPasteChartObject).Select

    'Set the title of the slide
        activeSlide.Shapes(1).TextFrame.TextRange.Text = "Additions summary" 

    'Adjust the positioning
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 15
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 125

    Next
Set activeSlide = Nothing
End If

If CB3 = 1 Then
This.Worksheets("End of Coverage Report").Select
*Same code as above*
Set activeSlide = Nothing
End If

If CB4 = 1 Then
This.Worksheets("LDoS Summary").Select
*Same code as above*
End If

If CB5 ... * and so on

我的想法在这里用完了。我不知道如何更正代码。有人可以帮忙吗？

Answer 1

我的建议是当您从 Excel vba 以编程方式创建 PowerPoint 并使用 ActiveSheet 等时，不要“选择”对象；直接将对象设置为您要使用的工作表。也就是说，虽然没有完全清理您的代码......这有效（仅注意到 CB1......但其余部分应该相似）：

代码更新

Option Explicit

Sub CreatePowerPoint()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    'declare the variables
    Dim newPowerPoint As PowerPoint.Application
    Dim newPresentation As Presentation
    Dim activeSlide As PowerPoint.Slide
    Dim cht As Excel.ChartObject
    Dim This As Workbook
    Set This = ActiveWorkbook
    
    Dim newWorksheet As Worksheet
    
     'look for existing instance
    On Error Resume Next
    Set newPowerPoint = GetObject(, "PowerPoint.Application")
    On Error GoTo 0
    
     'create a new PowerPoint
    If newPowerPoint Is Nothing Then
        Set newPowerPoint = New PowerPoint.Application
    End If
    Set newPresentation = newPowerPoint.Presentations.Add
    newPowerPoint.Visible = True
    
     'TBA Starting Slides/Agenda
     '  *Code here*
    
    'Check if report was selected, if yes perform addition of new slides with graphs and tables
    
    'If CB1 = 1 Then
    If 1 = 1 Then
        Set newWorksheet = This.Worksheets("Coverage Summary")
        For Each cht In newWorksheet.ChartObjects
    
            'Add a new slide and setup the slide title
            Set activeSlide = newPresentation.Slides.Add(newPresentation.Slides.Count + 1, ppLayoutTitleOnly)
            activeSlide.Shapes(1).TextFrame.TextRange.Text = "Coverage Summary"
            
            ' Copy in the chart and adjust its position
            cht.Copy
            activeSlide.Shapes.PasteSpecial DataType:=ppPasteDefault
            With activeSlide.Shapes(activeSlide.Shapes.Count)
                .Top = 125
                .Left = 15
                ' and could you also set .Width and .Height here as well ...
            End With

        Next
    End If
    
    'If CB2 = 1 Then
    If 1 = 1 Then
        Set newWorksheet = This.Worksheets("Additions Report")
        For Each cht In newWorksheet.ChartObjects
    
            'Add a new slide and setup the slide title
            Set activeSlide = newPresentation.Slides.Add(newPresentation.Slides.Count + 1, ppLayoutTitleOnly)
            activeSlide.Shapes(1).TextFrame.TextRange.Text = "Additions Report"
            
            ' Copy in the chart and adjust its position
            cht.Copy
            activeSlide.Shapes.PasteSpecial DataType:=ppPasteDefault
            With activeSlide.Shapes(activeSlide.Shapes.Count)
                .Top = 125
                .Left = 15
                ' and could you also set .Width and .Height here as well ...
            End With

        Next
    End If
    
End Sub

这是测试数据集的图片

这是输出 PowerPoint 的图片：