Identify and differ msoRectangle, option button textbox

[MD]

Good morning all,

I have sheets that contain Option buttons, Text boxes, Shapes (rectangles).
I would like to identify what they are and do a loop that does this.

If it's a shape with no fill color (transparent), do nothing
If it's an option button, change from msoGradientMoss to
msoGradientParchment
If it's Text box with no color (transparent), do nothing

If it's Text box with color fill color X change to fill color Y


Regards,

MD

This is what I have but it doesn't work fully.

Sub test()
MyTotal = ActiveSheet.Shapes.Count
Dim MyColor
i = 1
Start1:
ActiveSheet.Shapes(i).Select ' selects a shape to modify
On Error GoTo start2
MyColor = Selection.ShapeRange.Fill.ForeColor.SchemeColor
If MyColor = 39 Then Selection.ShapeRange.Fill.ForeColor.SchemeColor =
64: i = i + 1: GoTo Start1
If MyColor = 15 Then Selection.ShapeRange.Fill.ForeColor.SchemeColor =
64: i = i + 1: GoTo Start1
If Selection.ShapeRange.Fill.Visible = msoFalse Then i = i + 1: MyColor
= 0: GoTo Start1
i = i + 1
GoTo Start1
start2:

ActiveSheet.Shapes(i).Select ' selects a shape to modify
If Selection.ShapeRange.Fill.Visible = msoFalse Then
i = i + 1
If i > MyTotal Then GoTo end_sub
GoTo start2
Else

If Selection.ShapeRange.Fill.ForeColor.SchemeColor = 64 Then i = i + 1:
GoTo start2
If MyColor = 0 Then i = i + 1: GoTo start2
Selection.ShapeRange.Fill.PresetGradient msoGradientFromCenter, 1,
msoGradientParchment
i = i + 1
If i > MyTotal Then GoTo end_sub

GoTo start2
End If

end_sub:
End Sub

 

[Doug Glancy]

MD,

I can never remember how to access worksheet controls, so this took me a
long time.. Assuming the OptionButtons are from the Forms toolbar, this
seems to work:

Sub test()
Dim sheet_shape As Shape

With Worksheets(1)
For Each sheet_shape In .Shapes
With sheet_shape
If .Type = msoFormControl Then
If .FormControlType = xlOptionButton Then
.Fill.PresetGradient msoGradientHorizontal, 1,
msoGradientParchment
End If
End If
End With
Next sheet_shape
End With
End Sub

I don't know if the first 2 arguments to PresetGradient are what you want,
but you can do what I did and turn on the ol' Macro Recorder to find out.

As you don't seem to need to do anything with rectangles, All you need to
figure out is the Textboxes with color "X".

hth,

Doug