VBA Copy/Paste Issues - PPTX Creation - excel

Question

Im using the below code to iterate over a table in excel that contains named ranges and position details for cells id like to copy over to a powerpoint presentation.
The code works perfectly. Except that, and for some reason its always random, the code throws a "Shapes.paste invalid request clipboard is empty" error. Debugging didnt help since it always stops at a different object or named range. I know VBA is a little finicky with its operations in that it starts the paste before actually completing the copy operation.
I tried the Application.Wait function which isnt the best solution, it slowed the code by 3 fold. As well do/doevents calls didnt help.
Any ideas on how to curb this VBA issue ??
Thanks!
Sub MyProcedure(PPT As Object, WKSHEET As String, RangeTitle As Range, SlideNumber As Long, FTsize As Variant, FT As Variant, SetLeft As Variant, SetTop As Variant, SetHeight As Variant, SetWidth As Variant, Bool As Boolean)
Dim shP As Object
Dim myShape As Object
Dim mySlide As Object
Dim tempSize As Integer, tempFont As String
Dim Mypath As String
Dim Myname As String
Dim myTitle As String
Dim ws As Worksheet
'Application.Calculation = xlManual
'Application.ScreenUpdating = False
Set ws = Worksheets(WKSHEET)
'select the name of report
Set shP = ws.Range(RangeTitle)
'select the ppt sheet you wish to copy the object to
Set mySlide = PPT.ActivePresentation.slides(SlideNumber)
'count the number of shapes currently on the PPT
shapeCount = mySlide.Shapes.Count
'copy the previously selected shape
Do
shP.Copy
'paste it on the PPT
DoEvents
mySlide.Shapes.Paste 'Special DataType:=ppPasteOLEObject, Link:=msoFalse
'wait until the count of shapes on the PPT increases, which signals that the past operation is finished.
'<~~ wait completion of paste operation
Loop Until mySlide.Shapes.Count > shapeCount
'adjust formatting of the newly copied shape: position on the sheet, font & size
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
With myShape
.Left = SetLeft
.Top = SetTop
.Width = SetWidth
.Height = SetHeight
.TextEffect.FontSize = FTsize
.TextEffect.FontName = FT
.TextEffect.FontBold = Bool
End With
'Application.CutCopyMode = False
'Application.Calculation = xlAutomatic
'Application.ScreenUpdating = True
End Sub
Sub LoopThrougMyData()
Dim FirstRow As Integer: FirstRow = 1
Dim LastRow As Integer: LastRow = Worksheets("Table").Range("A1").End(xlDown).Row
Dim iRow As Long
Dim PPT As Object
Set PPT = CreateObject("PowerPoint.Application")
Myname = ThisWorkbook.Name
Mypath = ThisWorkbook.Path
PPT.Visible = True
PPT.Presentations.Open Filename:=Mypath & "\Actuals Review Temp.pptx"
For iRow = FirstRow To LastRow 'loop through your table here
With Worksheets("Table").Range("test")
MyProcedure PPT, WKSHEET:=.Cells(iRow, "A"), RangeTitle:=.Cells(iRow, "B"), SlideNumber:=.Cells(iRow, "C"), FTsize:=.Cells(iRow, "D"), FT:=.Cells(iRow, "E"), SetLeft:=.Cells(iRow, "F"), SetTop:=.Cells(iRow, "G"), SetHeight:=.Cells(iRow, "H"), SetWidth:=.Cells(iRow, "I"), Bool:=.Cells(iRow, "J")
'call the procedure with the data from your table
End With
Next iRow
End Sub

Answer 1

It's more than likely a clipboard issue. This is a common bug in VBA when copying information from one application to the other application. The best solution I've found so far is simply pausing the Excel application for a few seconds in between the copy and paste. Now this won't fix the issue in every single instance but I would say 95% of the time it fixes the error. The other 5% of the time is simply the information being removed from the clipboard randomly.
Change this section:
shP.Copy
'paste it on the PPT
DoEvents
mySlide.Shapes.Paste 'Special DataType:=ppPasteOLEObject, Link:=msoFalse
With this:
'Copy the shape
shP.Copy
'Pause the Excel Application For Two Seconds
Application.Wait Now() + #12:00:02 AM#
'Paste the object on the slide as an OLEObject
mySlide.Shapes.Paste 'Special DataType:=ppPasteOLEObject, Link:=msoFalse