Editing color/msoGradiant of shapes, option button and text boxes

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

Your question lacks information, so the best anyone could do is give a
partial answer and/or guess as to what you might want

> If it's a shape with no fill color (transparent), do nothing

Else what

Textboxes and Optionbuttons are shapes as are just about any other type of
object on a sheet. Are these included or excluded at this stage. What type
of shape(s).

> If it's an option button, change from msoGradientMoss to
> msoGradientParchment

Change all Option buttons or only those with msoGradientMoss, but not those
with transparent, perhaps.

Regards,
Peter T




"MD" <[email protected]> wrote in message
news:wAs2g.32363$U%[email protected]...
> 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
>
>