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
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