CLR said:
This code will draw a "cube" parametrically to values stated in A1:A4
The depth dimension is not controllable directly, except that it varies
according to the shorter of the Width and Height dimensions.
Sub DrawCube()
'=============================================
'draws a cube to cell values, by Chuck Roberts, CABGx3
'A1=Horizontal position
'A2=Vertical position
'A3=Width
'A4=Height
'==============================================
Dim shp As Shape
For Each shp In ActiveWorkbook.ActiveSheet.Shapes
If shp.AutoShapeType = msoShapeCube Then shp.Delete
Next shp
ActiveSheet.Shapes.AddShape(msoShapeCube, Range("a1").Value,
Range("a2").Value, Range("a3").Value, Range("a4").Value).Select
Range("A5").Select
End Sub
hth
Vaya con Dios,
Chuck, CABGx3
I modified your code, hope you don't mind, it seems to give me what I
am looking for. Thanks for the great idea.
Sub DrawCube()
'=============================================
'draws a cube to cell values, by Chuck Roberts, CABGx3
'A1=Horizontal position
'A2=Vertical position
'A3=Width
'A4=Height
A5=Length <---- added
'==============================================
Dim shp As Shape
ActiveSheet.Shapes.AddShape(msoShapeRectangle, Range("a1").Value,
Range("a2").Value, Range("a3").Value, Range("a4").Value).Select
Shapes.SelectAll
Selection.ShapeRange.ThreeD.Visible = msoTrue
Selection.ShapeRange.ThreeD.Depth = Range("a5")
Range("e4").Select
End Sub