VBA to find all rectangles

[Joke]

I'm using this macro to change all checkboxes in a sheet

Dim chbox As CheckBox
For Each optBut In ActiveSheet.OptionButtons
optBut.Enabled = False
Next optBut

I would like todo the same with a large number of rectangles on the same sheet. But what is the code to look for all rectangles???

I have been looking around but can't find anything.

Thanks for advise,
Joke

 

[Joe Was]

You must have a way to identify the shape, the best way is to give it a name and a number then use a loop to go to each of the names for action:

Sub myAdd4PointStar1()
'Run from Standard Module#.

Application.CommandBars("AutoShapes").Visible = False

'Note: For the remove to work you must re-name your shape.
With ActiveSheet.Shapes.AddShape(msoShape4pointStar, _
321.75, 201#, 102#, 86.25)
.Name = "4PointStar1"
End With

Range("A1").Select
End Sub

Sub myRemove4PointStar1()
'Run from Standard Module#.

Application.CommandBars("AutoShapes").Visible = False

ActiveSheet.Shapes("4PointStar1").Delete
'The shape was renamed in the add.
'ActiveSheet.Shapes("msoShape4pointStar").Select 'This original was re-named in the add.
Range("A1").Select
End Sub

 

[Joke]

I'm using a number of this kind of select statements but thought there was an easier way of searching all rectangle shapes.

As I have already identified all numbers given automatically by Excel, there is probably no added advantage of giving all rectangles on each sheet one name.

Sheet7.Shapes.Range(Array("rectangle 14", "rectangle 13", "rectangle 30", "rectangle 32", "rectangle 27", "rectangle 28", "rectangle 41", "rectangle 35")).Select
Call Call_botones

Thanks for clarifying!

Joke

 

[Greg Truby]

Why not just loop through the collection of shapes and check the type?
<font face=Courier New>
<SPAN style="color:#00007F">Sub</SPAN> McShapes()
    <SPAN style="color:#00007F">Dim</SPAN> s <SPAN style="color:#00007F">As</SPAN> Shape
    
    <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> s <SPAN style="color:#00007F">In</SPAN> ActiveSheet.Shapes
        <SPAN style="color:#00007F">If</SPAN> s.AutoShapeType = msoShapeRectangle <SPAN style="color:#00007F">Then</SPAN>
            s.Fill.ForeColor.SchemeColor = 14
        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
    <SPAN style="color:#00007F">Next</SPAN> s

<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
</FONT>

HTH

 

[Greg Truby]

If you wanted to create an array and hit all the shapes at once instead of one-by-one in a loop:
<font face=Courier New>
<SPAN style="color:#00007F">Sub</SPAN> McShapesArray()
    <SPAN style="color:#00007F">Dim</SPAN> s <SPAN style="color:#00007F">As</SPAN> Shape, varArray() <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN>, i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>
    
    <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> s <SPAN style="color:#00007F">In</SPAN> ActiveSheet.Shapes
        <SPAN style="color:#00007F">If</SPAN> s.AutoShapeType = msoShapeRectangle <SPAN style="color:#00007F">Then</SPAN>
            <SPAN style="color:#00007F">ReDim</SPAN> <SPAN style="color:#00007F">Preserve</SPAN> varArray(i)
            varArray(i) = s.Name
            i = i + 1
        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
    <SPAN style="color:#00007F">Next</SPAN> s

    <SPAN style="color:#00007F">With</SPAN> ActiveSheet.Shapes.Range(varArray).Fill
        .ForeColor.SchemeColor = 50
        .BackColor.SchemeColor = 48
        .Transparency = 0#
        .TwoColorGradient msoGradientHorizontal, 3
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>

<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
</FONT>

 

[Joke]

Thanks that looks very nice !

Joke