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
