Copy from Excel to Powerpoint error

Question

Again with the help of the kind resources around stackoverflow, I have been using the code below to copy information from Excel 2010 into Powerpoint 2010 slides. I repeat the code in the middle about 20 times for my slides.

I start to get the message intermittently

Run-time error -2147417851 (80010105) method 'pastespecial' of object 'shapes' failed

on this line:

Set ppShape = PPSlide.Shapes.PasteSpecial(DataType:=ppPasteOLEObject, Link:=msoFalse)

Here is the rest of the code:

Sub PPTReport()

Dim PPApp As PowerPoint.Application
Dim PPSlide As PowerPoint.Slide
Dim PPPres As PowerPoint.Presentation
Set PPApp = CreateObject("Powerpoint.Application")
Dim SlideNum As Integer
Dim wbk As Workbook
'Dim ppShape As PowerPoint.Shape
Dim ppShape As Object

Set XLApp = GetObject(, "Excel.Application")

''define input Powerpoint template
    Dim strPresPath As String, strExcelFilePath As String, strNewPresPath As String
''# Change "strPresPath" with full path of the Powerpoint template
strPresPath = ThisWorkbook.Path & "\template\template.ppt"
''# Change "strNewPresPath" to where you want to save the new Presentation to be created
strNewPresPath = ThisWorkbook.Path & "\electra_status_report-" & Format(Date, "yyyy-mm-dd") & ".ppt"
    Set PPPres = PPApp.Presentations.Open(strPresPath)
    PPPres.Application.Activate


PPApp.Visible = True
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''define destination slide
    SlideNum = 1
    PPPres.Slides(SlideNum).Select
    Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)

''define source sheet
strFirstFile = ThisWorkbook.Path & "\workstreams\ws1.xlsx"
Set wbk = Workbooks.Open(strFirstFile)

wbk.Sheets("WS1").Activate
    Cells(1, 1).Activate
'copy/paste from
    XLApp.Range("WS1Dash").Copy
Set ppShape = PPSlide.Shapes.PasteSpecial(DataType:=ppPasteOLEObject, Link:=msoFalse)

'place size and shape 72 ppi
ppShape.Width = 718
ppShape.Left = 1
ppShape.Top = 16

    PPPres.Application.Activate
    wbk.Sheets("WS1").Activate
    Cells(1, 1).Copy
wbk.Close savechanges:=False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''define destination slide
    SlideNum = 2
    PPPres.Slides(SlideNum).Select
    Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)

''define source sheet
strFirstFile = ThisWorkbook.Path & "\workstreams\ws2.xlsx"
Set wbk = Workbooks.Open(strFirstFile)

wbk.Sheets("WS2").Activate
    Cells(1, 1).Activate

'copy/paste from
    XLApp.Range("WS2Dash").Copy
Set ppShape = PPSlide.Shapes.PasteSpecial(DataType:=ppPasteOLEObject, Link:=msoFalse)

'place size and shape 72 ppi
ppShape.Width = 718
ppShape.Left = 1
ppShape.Top = 16

    PPPres.Application.Activate
    wbk.Sheets("WS2").Activate
    Cells(1, 1).Copy
wbk.Close savechanges:=False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'    Sheets("Dashboard").Activate
' Close presentation
    PPPres.SaveAs strNewPresPath
    PPPres.Close
' Quit PowerPoint
    PPApp.Quit

' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing

   AppActivate "Microsoft Excel"
MsgBox "Presentation Created", vbOKOnly + vbInformation

End Sub

Any thoughts on how to resolve this error?

Answer 1

The problem that you are facing is because the copying is taking time and the next line is getting executed and it doesn't find anything in the clipboard to paste.

Two ways to handle this problem

Way 1

XLApp.Range("WS1Dash").Copy
DoEvents
Set ppShape = PPSlide.Shapes.PasteSpecial(DataType:=ppPasteOLEObject, Link:=msoFalse)

Way 2

XLApp.Range("WS1Dash").Copy
Wait 2
Set ppShape = PPSlide.Shapes.PasteSpecial(DataType:=ppPasteOLEObject, Link:=msoFalse)

And paste this at the bottom of your procedure

Private Sub Wait(ByVal nSec As Long)
    nSec = nSec + Timer
    While nSec > Timer
        DoEvents
    Wend
End Sub

Lemme know if this doesn't help...

Answer 2

I was having the same problem and it happened as I was trying to export from Excel to PowerPoint without the PowerPoint reference, using it as object. The tricky thing was that sometimes it worked, other times it won´t. So after some testing I found out that it depends on the state of the PowerPoint View, if it is showing Thumbnails or a normal Slide view.

To fix it, set the ViewType as normal before pasting.

PPAP.ActiveWindow.ViewType = ppViewNormal

or

PPAP.ActiveWindow.ViewType = 9

PPAP stands for PowerPoint Application Object.