Run-Time 1004 Array Copy Error Charts to PPT

[Sphinx404]

I am having a problem that I've been trying to figure out for 4 days now and I have no idea what is going on. I've triple checked everything and I cannot for the life of me figure out why I'm getting the run-time 1004 error. I don't know where else to turn.

the following code:

Sub SCOM_Charts1()


ActiveSheet.Shapes.Range(Array("Object 4")).Select
    Selection.Verb Verb:=3


If Not Application.CalculationState = xlDone Then DoEvents
Application.CalculateUntilAsyncQueriesDone


Dim acslide As Slide
Dim myPresentation As Object, mySlide As Object, PowerPointApp As Object, shp As Object
Dim MySlideArray As Variant, MyChartArray As Variant, X As Long, ns%


Application.ScreenUpdating = False


On Error Resume Next
Set PowerPointApp = GetObject(class:="PowerPoint.Application")
Err.Clear


If PowerPointApp Is Nothing Then
    MsgBox "PowerPoint Presentation is not open, action aborted."
    Exit Sub
End If


If Err.Number = 429 Then
    MsgBox "PowerPoint could not be found, action aborted."
    Exit Sub
End If
On Error GoTo 0


PowerPointApp.ActiveWindow.Panes(2).Activate


Set myPresentation = PowerPointApp.ActivePresentation


MySlideArray = Array(2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15)


MyChartArray = Array(Sheet2.ChartObjects("Assy1"), Sheet2.ChartObjects("Assy2"), Sheet2.ChartObjects("Assy4"), Sheet2.ChartObjects("Assy7"), Sheet2.ChartObjects("Assy8"), Sheet1.ChartObjects("Velocity2"), _
Sheet1.ChartObjects("Velocity1"), Sheet1.ChartObjects("Velocity4"), Sheet1.ChartObjects("Velocity3"), Sheet4.ChartObjects("Free1"), Sheet4.ChartObjects("Free2"), Sheet4.ChartObjects("Free3"), _
Sheet4.ChartObjects("Free4"), Sheet5.ChartObjects("Assigned1"), Sheet3.ChartObjects("RTY1"))


For X = LBound(MySlideArray) To UBound(MySlideArray)
    MyChartArray(X).Copy - ERRORS OUT HERE
    DoEvents
    Set acslide = myPresentation.Slides(MySlideArray(X))
    ns = acslide.Shapes.Count
    Set shp = acslide.Shapes.PasteSpecial
    JustDoIt ns + 1
    On Error Resume Next
    shp.LinkFormat.BreakLink
    On Error GoTo 0
    Application.CutCopyMode = False
Next


Application.ScreenUpdating = True
Application.DisplayAlerts = True
ThisWorkbook.Activate
MsgBox "Export to PowerPoint complete. Note: **All slides will be lost when this workbook is closed.**"
End Sub
Sub JustDoIt(I%)


Dim pptcht1 As PowerPoint.Shape, cnt%
On Error Resume Next
cnt = 0
Do
    DoEvents
    Set pptcht1 = acslide.Shapes(I)
    If Not pptcht1 Is Nothing Then Exit Do
    cnt = cnt + 1
    If cnt > 100 Then Exit Do
Loop
Debug.Print cnt
On Error GoTo 0


End Sub

Craps out after it copies either slide #2 and sometimes #3.

I just don't understand it. Why oh why! For the love of Santa Claus, please help me!

[georgiboy]

If you simplify the code (I will paste below) you will see it works just fine, from reading through the code i believe the issue is that one of your chart names/sheets or slide numbers are wrong. When it debugs you may by hovering the mouse over the yellow writing be able to figure out which chart or slide it cannot find.

Also you have 14 slides and 15 charts.

    MySlideArray = Array(1, 2)    
    MyChartArray = Array(Sheet1.ChartObjects("Chart 1"), Sheet2.ChartObjects("Chart 1"))
    
    For X = LBound(MySlideArray) To UBound(MySlideArray)
        
        MyChartArray(X).Copy ' - ERRORS OUT HERE
        DoEvents
        Set acslide = myPresentation.Slides(MySlideArray(X))
        ns = acslide.Shapes.Count
        Set shp = acslide.Shapes.PasteSpecial
        JustDoIt ns + 1
        On Error Resume Next
        shp.LinkFormat.BreakLink
        On Error GoTo 0
        Application.CutCopyMode = False
    Next

Hope this helps