vbaexcel

VBA method 'range of object' _Worksheet failed Shapes.Range(Array


I am trying to move shapes on the 2nd sheet based on the values of the 1st sheet. I keep getting an error with the line....Shapes.Range(Array(.... below is the code.

Sub graphics_mover()
' graphics_mover Macro

Dim SWL_row As Double, PWL_row As Double
Dim rng As Variant, i As Integer, colNum As Integer, Data As Worksheet, Pict As Worksheet
Set Data = ThisWorkbook.Worksheets(1)
'Set Pict = ThisWorkbook.Worksheets(2)
Set Pict = Workbooks("Well Pictographs2.xlsm").Worksheets(2)
i = 1
For i = 1 To 27
    SWL_row = Data.Cells(2, i + 1).Value
    SWL_row = Int(SWL_row / 50 + 1)
    Pict.Shapes.Range(Array("Isosceles Triangle " & i)).Select
    Selection.Top = SWL_row * 15 + 4

    PWL_row = Data.Cells(3, i + 1).Value
    PWL_row = Int(PWL_row / 50 + 1)
    Pict.Shapes.Range(Array("Freeform " & i)).Select
    Selection.Top = PWL_row * 15 + 1
    i = i + 1
Next i
    '--------------------------
End Sub

the line that is causing the error is:

    Pict.Shapes.Range(Array("Freeform " & i)).Select

I appreciate any solutions.


Solution

  • I'm curious as to what the value of i is when you crash. The code is largely the same as a recorded macro but the syntax is correct if the named shape(s) exist.

    First run this small snippet to output all of the shapes' names to the VBE's Immediate Window (Ctrl+G).

    Sub List_Shapes()
        Dim i As Long
        With Workbooks("Well Pictographs2.xlsm").Worksheets(2)
            For i = 1 To .Shapes.Count
                Debug.Print .Shapes(i).Name
            Next i
        End With
    End Sub
    

    When you are in the VBE, tap Ctrl+G to open the Immediate Window and check the output. Make sure you have Isosceles Triangle 1 through Isosceles Triangle 27 (inclusive).

    Next run through this modification of your macro.

    Sub graphics_mover()
        Dim SWL_row As Double, PWL_row As Double
        Dim rng As Variant, i As Integer, colNum As Integer, Data As Worksheet, Pict As Worksheet
    
        On Error Resume Next
        Set Data = ThisWorkbook.Worksheets(1)
    
        With Workbooks("Well Pictographs2.xlsm").Worksheets(2)
            For i = 1 To 27
                SWL_row = Data.Cells(2, i + 1).Value
                SWL_row = Int(SWL_row / 50 + 1)
                If Not .Shapes("Isosceles Triangle " & i) Is Nothing Then
                    .Shapes("Isosceles Triangle " & i).Top = SWL_row * 15 + 4
                    Debug.Print "moved " & .Shapes("Isosceles Triangle " & i).Name
                End If
    
                PWL_row = Data.Cells(3, i + 1).Value
                PWL_row = Int(PWL_row / 50 + 1)
                If Not .Shapes("Freeform " & i) Is Nothing Then
                    .Shapes("Freeform " & i).Top = PWL_row * 15 + 1
                    Debug.Print "moved " & .Shapes("Freeform " & i).Name
                End If
            Next i
        End With
    End Sub
    

    I'm not a big fan of using On Error Resume Next but you are dealing with an object that is avoiding detection. The VBE's Immediate window will report the shapes that it could move.