Excel till Powerpoint

[DanneK]

Hej,

får inte följande att fungera, tänkte att jag säkert gjort ett enkelt fel varvid jag ställer frågan här.
Använder följande kod (eller, ja, det var ursprungligen en del av en större loop, men jag har försökt få det att fungera och har minskat ned så långt som möjligt) för att exportera givna diagram till en ppt.
Någonstans på vägen har jag lyckats snurra till det varvid allt fallerar numera.

 

Microsoft Powerpoint Libary är aktivt

 

Sub ToMonthly()
    
    Dim PP As PowerPoint.Application
    Dim PPPres As PowerPoint.Presentation
    Dim PPSlide As PowerPoint.Slide
    Dim SlideTitle As String
    Dim shp As Object
    Dim strPP As String
    
    
    strPP = ThisWorkbook.Path & "\" & "2020board.pptx"
    
    Set PP = New PowerPoint.Application
    Set PPPres = PP.Presentations.Open(strPP)
    PP.Visible = True
    
    Sheets("Utfall").Chart("Diagram 3").CopyPicture _
        Appearance:=xlScreen, Format:=xlPicture

    PPSlide.Shapes.Paste.Select
    Set shp = PP.ActiveWindow.Selection.ShapeRange
    shp.Height = 600
    shp.Width = 600
    
    With PPPres.PageSetup
        shp.Left = (.SlideWidth / 2) - (shp.Width / 2)
        shp.Top = (.SlideHeight / 2) - (shp.Height / 2)
    End With
   
   PP.Activate
    Set PPSlide = Nothing
End Sub

 

[DanneK]

Sub ToMonthly()
    
    Dim PP As PowerPoint.Application
    Dim PPPres As PowerPoint.Presentation
    Dim PPSlide As PowerPoint.Slide
    Dim SlideTitle As String
    Dim shp As Object
    Dim strPP As String
    
    
    strPP = ThisWorkbook.Path & "\" & "2020Board.pptx"
    
    Set PP = New PowerPoint.Application
    Set PPPres = PP.Presentations.Open(strPP)
    PP.Visible = True
    
       
' Här hade jag visst strulat till det.
' Detta fungerar om någon annan hittar denna tråd
    Set PPSlide = PPPres.Slides.Add(2, ppLayoutTitleOnly)
    PPSlide.Select
    
    Sheets("Utfall").ChartObjects("Diagram 3").CopyPicture _
        Appearance:=xlScreen, Format:=xlPicture

    PPSlide.Shapes.Paste.Select
    Set shp = PP.ActiveWindow.Selection.ShapeRange
    shp.Height = 600
    shp.Width = 600
    
    With PPPres.PageSetup
        shp.Left = (.SlideWidth / 2) - (shp.Width / 2)
        shp.Top = (.SlideHeight / 2) - (shp.Height / 2)
    End With
   
   PP.Activate
    Set PPSlide = Nothing
End Sub