I'm trying to automate copying of certain exhibits from Excel to a PPT template for ~500 different situations. Unfortunately, I am running into errors where it throws error 462 inconsistently. I've looked through online sources for a few hours and couldnt find anything that helped. I understand a common error is late binding; however, I've tried to apply this as best as I could. Your help is very much appreciated..
Dim myBook As Workbook
Set myBook = ThisWorkbook
Dim pptName As String
Dim DestinationPPT As String
Dim myShape As Object
Dim ppt As Object
Dim mySlide As Object
Dim pptA As Object
Set pptA = CreateObject("PowerPoint.Application")
DestinationPPT = myBook.path & "\template.pptx"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Call Module1.mkdirectories(myBook.path)
Dim inputRange As Excel.Range
Dim c As Excel.Range
Dim worksheetCt As Integer
worksheetCt = 8
myBook.Worksheets("input").Activate
Set inputRange = Evaluate(myBook.Worksheets("input").Range("c4").Validation.Formula1)
For Each c In inputRange
Range("c4").Value = c
Calculate
Set ppt = pptA.Presentations.Open(DestinationPPT)
For worksheetCt = 8 To 39
'On Error Resume Next
myBook.Activate
myBook.Worksheets(worksheetCt).Range("Print_Area").Copy
DoEvents
pptA.Activate
'ppt.Activate
Set mySlide = ppt.Slides(worksheetCt - 5)
'Call Module1.UglyWait
**mySlide.Shapes.PasteSpecial DataType:=2**
'Call Module1.UglyWait
**Set myShape = mySlide.Shapes(mySlide.Shapes.Count)**
bolded lines are where the code fails..
I have found that by doing all of my copying and pasting of charts in a separate procedure I've stopped having the problem. I guess passing the slide to another procedure magically results in it being valid, and putting the copy/paste in a loop where it tries multiple times seems to have solved the pasting problem.
Public Sub PPPasteShape(mySlide As PowerPoint.Slide, pc As ChartObject)
Dim i As Integer
Dim worked As Boolean
i = 0
pc.Copy
worked = False
Do While (i < 5 And worked = False)
Debug.Print "Try: " & CStr(i)
If i > 0 Then
Application.Wait (Now + TimeValue("0:00:01"))
End If
worked = PPTryPasteShape(mySlide)
i = i + 1
Loop
End Sub
Public Function PPTryPasteShape(mySlide As PowerPoint.Slide) As Boolean
On Error GoTo err
mySlide.Shapes.Paste
PPTryPasteShape = True
Exit Function
err:
PPTryPasteShape = False
End Function
Public Sub PPPasteRange(mySlide As PowerPoint.Slide, rng As Range)
Dim i As Integer
Dim worked As Boolean
i = 0
rng.Copy
Do While (i < 5 And worked = False)
Debug.Print "Try: " & CStr(i)
If i > 0 Then
Application.Wait (Now + TimeValue("0:00:01"))
End If
worked = PPTryPasteRange(mySlide)
i = i + 1
Loop
End Sub
Public Function PPTryPasteRange(mySlide As PowerPoint.Slide) As Boolean
On Error GoTo err
mySlide.Shapes.Paste
PPTryPasteRange = True
Exit Function
err:
PPTryPasteRange = False
End Function
Maybe declare it as
Dim myShape As Powerpoint.Shape
Dim ppt As Powerpoint.Presentation
Dim mySlide As Powerpoint.Slide
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.