+ Reply to Thread
Results 1 to 2 of 2

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

  1. #1
    MD
    Guest

    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. #2
    Peter T
    Guest

    Re: 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" <xxx@xxx.com> wrote in message
    news:wAs2g.32363$U%4.523436@weber.videotron.net...
    > 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 to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1