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