Опять же, с помощью таких ресурсов, как stackoverflow, я использовал приведенный ниже код для копирования информации из Excel 2010 в слайды Powerpoint 2010. Я повторяю код в середине около 20 раз для моих слайдов.

Я начинаю получать сообщения с перерывами

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

на этой линии:

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

Вот остальная часть кода:

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

Есть мысли о том, как решить эту ошибку?