Resize MANY shapes from range of cell values, including shape.ThreeD.depth

[Bricklin]

How do we revise VBA code for one item to apply to many? Sorry that I don't yet understand how to use the RANGE object.
Today I am struggling to apply VBA code to many shapes. I see how to create ONE shape based on cell values:
how-to-make-box-with-dimension.587948/#post-2908982
Likewise, we can change the shape of ONE existing shape.

But suppose we have a hundred shapes to manage. Dimensions of the first shape are in, say, row 3. Dimensions for the second shape are in row 4, and so forth to row 103.
How then do we connect the shapes with their rows? The code below links the properties of the first shape to the values in row 3. But all the other shapes are also wrongly linked to row 3. I can imagine how to fix this, but my approach would be tedious and error-prone.

Sub ChangeShapes()
Const X = "b3"
Const Y = "c3"
Const Z = "d3"
Const R = "e3"
Const Rx = "f3"
Const Ry = "g3"
Const Rz = "h3"
Dim mySheet As Worksheet
Dim myS As Shape
Set mySheet = activesheet
For Each myS In mySheet.Shapes
        myS.Width = Range(X)
        myS.Height = Range(Y)
        myS.ThreeD.Depth = Range(Z)
        myS.Rotation = Range(R)
        myS.ThreeD.RotationX = Range(Rx)
        myS.ThreeD.RotationY = Range(Ry)
        myS.ThreeD.RotationZ = Range(Rz)
Next myS
End Sub

Thanks

 

[kevin9999]

Rather than using the Range object, I would use the Cells method because It's easier to increment. Please try the following on a copy of your workbook - I think it's giving you what you want.

Option Explicit
Sub Change_Shapes()
    Dim mySheet As Worksheet
    Dim myS As Shape
    Dim i As Long
    
    Set mySheet = ActiveSheet                   '<< better to specify the actual sheet name
    i = 3                                       '<< starting at row 3
    On Error Resume Next
    For Each myS In mySheet.Shapes
        myS.Width = mySheet.Cells(i, 2)         '<< i, 2 = row 3 column 2 (B) etc down the list
        myS.Height = mySheet.Cells(i, 3)
        myS.ThreeD.Depth = mySheet.Cells(i, 4)
        myS.Rotation = mySheet.Cells(i, 5)
        myS.ThreeD.RotationX = mySheet.Cells(i, 6)
        myS.ThreeD.RotationY = mySheet.Cells(i, 7)
        myS.ThreeD.RotationZ = mySheet.Cells(i, 8)
        
        i = i + 1                               '<< increment row by 1 for each shape
    On Error GoTo 0
    Next myS

End Sub

 

[Bricklin]

Thanks to Kevin9999. I added a few lines to his code:

       myS.Width = mySheet.Cells(i, 3)         '<< i, 2 = row 3 column 2 (B) etc down the list
        myS.Height = mySheet.Cells(i, 4)
        myS.ThreeD.Depth = mySheet.Cells(i, 5)
        myS.Rotation = mySheet.Cells(i, 6)
        myS.ThreeD.RotationX = mySheet.Cells(i, 7)
        myS.ThreeD.RotationY = mySheet.Cells(i, 8)
        myS.ThreeD.RotationZ = mySheet.Cells(i, 9)
        myS.Left = mySheet.Cells(i, 10)
        myS.Top = mySheet.Cells(i, 11)

With nice results below showing a set of deck joists. Yes, tinkercad would be easier for repetitive 3D but I have a situation with irregular joists. FYI, you can draw in Tinkercad and export to obj file. You can then open that in Excel, or you can copy the numbers in the OBJ and paste into excel.

 

[Bricklin]

Thanks to Kevin9999. I added a few lines to his code:

       myS.Width = mySheet.Cells(i, 3)         '<< i, 2 = row 3 column 2 (B) etc down the list
        myS.Height = mySheet.Cells(i, 4)
        myS.ThreeD.Depth = mySheet.Cells(i, 5)
        myS.Rotation = mySheet.Cells(i, 6)
        myS.ThreeD.RotationX = mySheet.Cells(i, 7)
        myS.ThreeD.RotationY = mySheet.Cells(i, 8)
        myS.ThreeD.RotationZ = mySheet.Cells(i, 9)
        myS.Left = mySheet.Cells(i, 10)
        myS.Top = mySheet.Cells(i, 11)

With nice results below showing a set of deck joists. Yes, tinkercad would be easier for repetitive 3D but I have a situation with irregular joists. FYI, you can draw in Tinkercad and export to obj file. You can then open that in Excel, or you can copy the numbers in the OBJ and paste into excel.

 

[kevin9999]

Happy to help, and thanks for the feedback