Search code examples
excelvbapowerpoint

Export Excel Dashboard to PowerPoint

I'm trying to create PPT generator based on Excel file and user input. So far I managed to create UserForm where user is defining what reports from Excel (chart plus table) he want to see on presentation. To define which report was selected I used global variables. Now when I'm trying to generate the presentation I'm getting error: "Run-time error '-2147023170(800706b3)': Automation error. The remote procedure call failed." Debug shows line newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutTitleOnly I've got multiple lines like this since I'm using function For to check if the report was selected (based on my global variables) and if yes, then repeat the code for each report. Below is the code itself. I'm not sure what I'm doing wrong.

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

I run out of ideas here. I don't know how to correct the code. Can someone please help?

Solution

  • My suggestion is not to "select" objects when you're programmatically creating PowerPoint from Excel vba and using ActiveSheet and the like; directly set objects to the sheets that you want to work with. That said, while not completely cleaning up your code ... this works (noting only for CB1 ... but the rest should be similar):

    CODE UPDATED

    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

    Here is a pic of the test data set

    screen1

    Here is a pic of the output PowerPoint:

    screen2