The dreaded 80048240 error PowerPoint Generation from VBA Excel - excel

Question

I know there are other posts here on the subject but none of the answers suggested seem to do the trick. Therefore posting my first ever post here (after getting fantastic answers here for years).
So I am generating PowerPoint-slides from Excel,and I actually have a code to that works. Problem is, it takes ages to run! As you can see below I use the Wait 2 command in the script. The code only shows you 1 slide, I am generating 20 in the script. So far I have tried:
Changing Wait 2 to Wait 1
Replacing the Wait command with DoEvents
Both of those results in the below messages showing up at random places in the script.
Run-time Error '2147188160 (80048240):
Shapes.PasteSpecial: Invalid Request. The specified data type is unavailable.
Sometimes however, when removing Wait, or changing to Wait 0.5 etc the script will run (!) and the slides will be completed in almost an instant. I do have a very fast and up-to-date laptop.
Would like this so be stable, and fast! isnt there any code I can add that just switches on/off the clipboard or something after each paste? Something that goes to the root of the problem.
This is the code from the first slide (slide 3) down to the start of slide 4, and as I say, it works..its just painfully slow.
Sub Powerpoint2()
'Dim stuff
Dim rng As Range
Dim Powerpointapp As Object
Dim myPresentation As Object
Dim DestinationPPT As String
Dim myShape As Object
Dim mySlide As Object
Dim objApplication As Excel.Application
Dim objWorkbook As Workbook
Dim objWorksheet As Worksheet
Dim objWorksheet2 As Worksheet
Dim objWorksheet3 As Worksheet
Dim objShape As Shape
Dim objSlide As Slide
Dim objPresentation As Presentation
'Set stuff
Set objWorkbook = ThisWorkbook
Set objWorksheet = objWorkbook.Worksheets("Main")
Set objWorksheet2 = objWorkbook.Worksheets("Implementation")
Set objWorksheet3 = objWorkbook.Worksheets("Cat")
'Optimize Code
Application.ScreenUpdating = False
'Get PowerPoint Ready
'Create an Instance of PowerPoint
On Error Resume Next
'Set your destination path for the powerpoint presentation and open the file
Set Powerpointapp = CreateObject("Powerpoint.application")
DestinationPPT = (ActiveWorkbook.Path & ".\template.pptx")
Powerpointapp.Presentations.Open (DestinationPPT)
'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
MsgBox "Powerpoint could not be found.aborting."
Exit Sub
End If
On Error GoTo 0
'Set my current Powerpoint window as activated
Set myPresentation = Powerpointapp.ActivePresentation
'SLIDE 3 Start _________________________________________
Sheets("Main").Select
Sheets("Main").Activate
Call mainviewall
Call sort
Call hidedates
Call hideonhold
'Insert Main data_________________
'find last row of main column L
Range("L65536").End(xlUp).Select
Do Until Len(ActiveCell) > 0
ActiveCell.Offset(-1, 0).Select
Loop
MyLastCell = ActiveCell.Address
'Set range
Set rng = Worksheets("Main").Range("E2", ActiveCell.Address)
'Set which slide to paste into
Set mySlide = myPresentation.Slides(3)
'Copy Excel Range
rng.Copy
DoEvents
Wait 2
'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
Wait 2
'Set position:
myShape.Left = 60
myShape.Top = 80
myShape.Height = 500
myShape.Width = 700
'clear The Clipboard
Application.CutCopyMode = False
'copy the first chart__________________
objWorksheet.ChartObjects("Chart 11").Select
Selection.Copy
DoEvents
Wait 2
'paste chart to powerpoint
mySlide.Select
mySlide.Shapes.PasteSpecial DataType:=3
Wait 2
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
With myShape
.Height = 150
.Top = 380
.Left = 750
End With
'copy chart table___________________
Set rng = Worksheets("Main").Range("AC6:AG11")
Set mySlide = myPresentation.Slides(3)
rng.Copy
DoEvents
Wait 2
mySlide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
Wait 2
'Set position:
myShape.Left = 60
myShape.Top = 400
myShape.Height = 100
myShape.Width = 300
'clear the clipboard
Application.CutCopyMode = False
'SLIDE 4 Start ____________________________________________________________________________
I also have this at the end for the "wait" to work:
Private Sub Wait(ByVal nSec As Long)
nSec = nSec + Timer
While nSec > Timer
DoEvents
Wend
End Sub

Answer 1

Sometimes just trying again seems to work, so you can extract that into a separate method:
Set rng = Worksheets("Main").Range("AC6:AG11")
Set mySlide = myPresentation.Slides(3)
If Not CopyPasteOK(rng, mySlide.Shapes, 2) Then Exit Sub 'call copy/paste/try again
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
Method:
Function CopyPasteOK(objSource As Object, objDest As Object, pasteType As Long)
Dim i As Long
For i = 1 To 5 'try 5 times....
objSource.Copy
DoEvents
On Error Resume Next
objDest.PasteSpecial DataType:=pasteType
If Err = 0 Then
CopyPasteOK = True
Exit For
End If
On Error GoTo 0
Next i
If Not CopyPasteOK Then 'warn on failure...
MsgBox "Copy/Paste failed!", vbExclamation
End If
End Function