Shape macro
Page 1 of 2 12 LastLast
Results 1 to 10 of 12

Thread: Shape macro

  1. #1
    New Member
    Join Date
    Aug 2019
    Posts
    6
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Shape macro

    Hi all,

    I am after a macro that when a button is clicked it changes the colour of a shape to say if the statement is complete, working towards or incomplete. I then need a cell to be linked to the cell so that if it is complete the cell shows 3, working towards 2, incomplete 1.

    I have a macro that fills the shapes fine but I cannot work out how to make a cell change value depending on the shape colour. There are roughly 36 shapes per worksheet.

    Any help would be great.

    Thanks,
    Luke

  2. #2
    Board Regular
    Join Date
    Mar 2015
    Posts
    3,745
    Post Thanks / Like
    Mentioned
    66 Post(s)
    Tagged
    7 Thread(s)

    Default Re: Shape macro

    Welcome to the forum

    Try this
    - shape linked to cell B1
    - B1 value alternates between 1, 2 & 3
    - shape colour alternates between Green, Blue & Red

    To link a shape to cell B1 (amend to whichever cell you want to use)

    - right click on any shape to select it
    - in formula bar type =B1 and hit Enter key

    Add this procedure to a module (amend colurs etc to whatever you prefer to use)

    Code:
    Sub ChangeColours()
        Dim cel As Range
        ActiveSheet.Shapes(Application.Caller).Select
        Set cel = Range(Selection.Formula)
       
            With Selection.ShapeRange.Fill.ForeColor
                Select Case .RGB
                    Case RGB(255, 0, 0)
                        .RGB = RGB(0, 255, 0)
                        cel = 1
                    Case RGB(0, 255, 0)
                        .RGB = RGB(0, 0, 255)
                        cel = 2
                    Case Else:
                        .RGB = RGB(255, 0, 0)
                        cel = 3
                End Select
            End With
            cel.Select
    End Sub
    Assign procedure to shape
    - right click on shape \ Assign Macro \ click on ChangeColours \ OK

  3. #3
    New Member
    Join Date
    Aug 2019
    Posts
    6
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Shape macro

    Hmmm i dont think this would work as I need the cell to change not the shape.


    If I could get the value of the shape to be the cell value I think I could get this to work but at the moment I can only get the shape to reference a cell and not vis versa.

  4. #4
    Board Regular
    Join Date
    Mar 2015
    Posts
    3,745
    Post Thanks / Like
    Mentioned
    66 Post(s)
    Tagged
    7 Thread(s)

    Default Re: Shape macro

    Please explain EXACTLY what you want the user to do and what should then happen to the shape and what should happen to the cell
    Last edited by Yongle; Aug 25th, 2019 at 03:20 PM.

  5. #5
    New Member
    Join Date
    Aug 2019
    Posts
    6
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Shape macro

    I have a number of sheets. On each sheet there are shapes that have statements written in that need to be completed.

    I have three buttons on the sheet that are assigned macros to colour the shapes to red if the statement is incomplete, orange if it is working towards and green if it has been completed.

    What I want to be able to do is count how many statements have been completed, working towards or incomplete.

    The easiest way would be to count the shapes but after reading a lot online it all says this can not be achieved as excel can’t see it as a colour.

    So my idea was to link the shape to a cell so that when whichever button was clicked (incomplete 1, working towards 2, complete 3) a number would appear in the shape which would then be linked to a cell. This way I can then count from the cells how many 1,2 or 3s appear giving me a count on the statements.

    Hope this makes sense.

    Luke.

  6. #6
    Board Regular
    Join Date
    Mar 2015
    Posts
    3,745
    Post Thanks / Like
    Mentioned
    66 Post(s)
    Tagged
    7 Thread(s)

    Default Re: Shape macro

    A method to count the number of shapes containing each colour ...

    1. Select the sheet containing the shapes
    2. Run this macro - it creates a new sheet with the colour values of each shape

    Code:
    Sub GetColours()
        Application.ScreenUpdating = False
        Dim shp As Shape, ws As Worksheet, sh As Worksheet, r As Long
        Set sh = ActiveSheet
        Set ws = Worksheets.Add
        sh.Activate
        For Each shp In sh.Shapes
            shp.Select
            r = r + 1
            ws.Cells(r, 1).Resize(, 2) = Array(Selection.Name, Selection.ShapeRange.Fill.ForeColor)
        Next
        Selection.TopLeftCell.Activate
        ws.Activate
    End Sub
    My test include red, green, and blue shapes
    The above VBA therefore returned these values
    Rectangle 2 255
    Rectangle 3 65280
    Rectangle 4 16711680
    etc

    3. Next use those values and modify the macro below to count your 3 colours

    Code:
    Sub CountColours()
        Application.ScreenUpdating = False
        Const A = 255, B = 65280, C = 16711680
        Dim AA As Long, BB As Long, CC As Long
        Dim shp As Shape
        For Each shp In ActiveSheet.Shapes
           shp.Select
           Select Case Selection.ShapeRange.Fill.ForeColor
              Case A: AA = AA + 1
              Case B: BB = BB + 1
              Case C: CC = CC + 1
           End Select
        Next shp
        Selection.TopLeftCell.Activate
        MsgBox AA & vbCr & BB & vbCr & CC
    End Sub
    Last edited by Yongle; Aug 27th, 2019 at 04:39 AM.

  7. #7
    New Member
    Join Date
    Aug 2019
    Posts
    6
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Shape macro

    Than you Yongle I will give this a go.

  8. #8
    New Member
    Join Date
    Aug 2019
    Posts
    6
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Shape macro

    Hi Yondle,

    This works quite well. Is there a way to paste the results onto the sheet instead of displaying it as a message box? Say cells A5,6,7.

    Thanks for your help,

    Luke

  9. #9
    Board Regular
    Join Date
    Mar 2015
    Posts
    3,745
    Post Thanks / Like
    Mentioned
    66 Post(s)
    Tagged
    7 Thread(s)

    Default Re: Shape macro

    Code:
    Range("A5:A7") = Array(AA, BB, CC)

  10. #10
    Board Regular
    Join Date
    Mar 2015
    Posts
    3,745
    Post Thanks / Like
    Mentioned
    66 Post(s)
    Tagged
    7 Thread(s)

    Default Re: Shape macro

    Oops - half asleep
    Let's try that again!

    Code:
    Range("A5:A7") = WorksheetFunction.Transpose(Array(AA, BB, CC))

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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