riniheijnen
02-21-2012, 01:05 PM
Good evening,
I am trying to copy an excelrange to a powerpointslide. Whenever I put this action into one macro everything works ok but if I put this action into a separate macro by means op pushing a button it won't succeed and gives an error:
"error -2147188160(80048240) while executing: Shapes(unknown member) : Invalid request. The specified data type is unavailable".
This error happens in the line where I paste de range in the active slide. Can anybody tell me why I get this error and what I need to change to get it working. Thanks for all suggestions.
Option Explicit
Sub tv_programma_zaterdag()
' tv_programma_zaterdag Macro kopieren range
'over here is some formatting which result in a 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
I am trying to copy an excelrange to a powerpointslide. Whenever I put this action into one macro everything works ok but if I put this action into a separate macro by means op pushing a button it won't succeed and gives an error:
"error -2147188160(80048240) while executing: Shapes(unknown member) : Invalid request. The specified data type is unavailable".
This error happens in the line where I paste de range in the active slide. Can anybody tell me why I get this error and what I need to change to get it working. Thanks for all suggestions.
Option Explicit
Sub tv_programma_zaterdag()
' tv_programma_zaterdag Macro kopieren range
'over here is some formatting which result in a 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