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

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

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" wrote in message
...
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