plakken range in powerpoint

[riniheijnen]

Goedemorgen allen

Ik probeer een excel-range te kopieren naar een powerpoint-slide. Als ik deze actie in 1 excel-macro plaats werkt alles prima maar als ik van deze actie een aparte macro maak die ik aanroep via een button dan krijg ik een foutmelding

"Fout-2147188160(80048240) tijdens uitvoering: Shapes(unknown member) : Invalid request. The specified data type is unavailable".

Deze foutmelding treed op in de regel waar ik de excel-range wil plakken in de actieve slide (zie dik gedrukte regel onderaan de code). Kan iemand mij vertellen hoe ik deze melding wegkrijg? Alvast bedankt voor alle suggesties.

Option Explicit

Sub tv_programma_zaterdag()
' tv_programma_zaterdag Macro 'kopieren range

hier worden regels en kolommen aangepast door code eindigend in een range Realusedrange

Realusedrange.Copy

'knop realusedrange naar powerpoint presentatie op werkblad
Cells(lastrow + 2, 3).Select
With Selection
ActiveSheet.Buttons.Add(ActiveCell.Left, ActiveCell.Top, 120, 60).Select
Selection.OnAction = "PERSONAL.XLSB!macro_powerpoint_slide"
Selection.Characters.Text = "Powerpoint" & vbCrLf & "Presentatie"
With Selection.Characters(Start:=1, Length:=23).Font
.Name = "Calibri"
.FontStyle = "Standaard"
.Size = 16
End With
End With

End Sub

Sub macro_powerpoint_slide()
'voor referentie naar powerpoint referentie zetten in tools > verwijzingen naar microsoft powerpont object library

Dim pptApp As PowerPoint.Application
Dim pptPrs As PowerPoint.Presentation
Dim pptSld As PowerPoint.Slide
Dim pptshp As PowerPoint.Shape
Dim FSO As Object
Dim I As Integer

Set pptApp = CreateObject("Powerpoint.application")

'powerpoint zichtbaar maken
pptApp.Visible = True

'ophalen sponsors template en slide maken
Set pptPrs = pptApp.Presentations.Open("C:\VVVierpolders\automation\Templates\TV-sponsors template." & "potx")
Set pptSld = pptPrs.Slides(1)
Set pptshp = pptSld.Shapes(1)

'plakken excel-tabel in powerpoint slide
pptSld.Shapes.PasteSpecial(ppPasteOLEObject).Select

'centreren excel-tabel op slide
pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

End Sub