Adding a Powerpoint slide using Excel vba

[db1966]

I have some code that copies graphs from a workbook to a Powerpoint template. Works fine, most of the time, but I want to add an end page (End Page.ppt) to the presentation, and I'm struggling

Here's the current code:-

Private Sub CommandButton2_Click()

    Dim PPApp As PowerPoint.Application
    Dim PPPres As PowerPoint.Presentation
    Dim PPSlide As PowerPoint.Slide
    Dim PPTTemp As Object
    
    
    Set PPTTemp = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then PowerpointWasNotRunning = True
    Err.Clear
    
'       DetectExcel
    
    Set PPTTemp = GetObject("C:\Data\Report Template PF.ppt")
    
    PPTTemp.Application.Visible = True
    
    If ExcelWasNotRunning = True Then
        PPTTemp.Application.Quit
    End If
    
    ' Reference instance of PowerPoint
    On Error Resume Next
    
    ' Check whether PowerPoint is running
    Set PPApp = GetObject(, "PowerPoint.Application")
    If PPApp Is Nothing Then
        ' PowerPoint is not running, create new instance
        Set PPApp = CreateObject("PowerPoint.Application")
        PPApp.Visible = True
    End If
    On Error GoTo 0

    ' Reference presentation and slide
    On Error Resume Next
    If PPApp.Windows.Count > 0 Then
        ' There is at least one presentation
        ' Use existing presentation
        Set PPPres = PPApp.ActivePresentation
        ' Use active slide
        Set PPSlide = PPPres.Slides _
            (PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
    Else
        ' There are no presentations
        ' Create new presentation
        Set PPPres = PPApp.Presentations.Add
        ' Add first slide
        'Set PPSlide = PPPres.Slides.Add(1, ppLayoutBlank)
    End If
    On Error GoTo 0

    ' Some PowerPoint actions work best in normal slide view
    PPApp.ActiveWindow.ViewType = ppViewSlide
    
     'Add a new slide and paste in the chart
    SlideCount = PPPres.Slides.Count
    Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutTitleOnly)
    PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex

    Worksheets("Graph").Range("B24:M61").CopyPicture _
    Appearance:=xlScreen, Format:=xlPicture
    
    ' Paste chart
    PPSlide.Shapes.Paste.Select

    ' Align pasted chart
    PPApp.ActiveWindow.Selection.ShapeRange.Left = 75
    PPApp.ActiveWindow.Selection.ShapeRange.Top = 60
    
    PPApp.ActiveWindow.Selection.ShapeRange.Width = 525
    
    PPSlide.Shapes.Placeholders(1).TextFrame.TextRange.Text = Worksheets("Graph").Range("B23")
    PPSlide.Shapes.Placeholders(1).TextFrame.TextRange.Font.Size = 28
    PPSlide.Shapes.Placeholders(1).TextFrame.TextRange.Font.Bold = msoTrue
    PPSlide.Shapes.Placeholders(1).Left = 31
    PPSlide.Shapes.Placeholders(1).Top = 18
    PPSlide.Shapes.Placeholders(1).Width = 613.3
    PPSlide.Shapes.Placeholders(1).Height = 42.3
    
    ' Clean up
    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set PPApp = Nothing

End Sub

Any help greatly appreciated.