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

M

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
 
P

Peter T

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top