Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Excel Charts and Shapes or Text Boxes that disappear | Charts and Charting in Excel | |||
text boxes and shapes in excel 2007 move when printing | Excel Discussion (Misc queries) | |||
how do you stop editing the text in a created button | Excel Discussion (Misc queries) | |||
In Excel, option to enter text in cells the same as text boxes | Excel Worksheet Functions | |||
Need help with Option Button dynamic background color | Excel Discussion (Misc queries) |