Macro Buttons change colour when pressed

Phill032

Board Regular
Joined
Nov 9, 2016
Messages
51
Hi,
Looking for a solution to my Macro button (shape) problem.
I have the below code which will colour a depressed button.
Problem is this will only work for 1 button and i have 12 that i want it to work for.
The idea would be that the button stays depressed until another button is selected.

Private Sub Worksheet_Change(ByVal Target As Range)
'Updateby Extendoffice 20160704
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
If IsNumeric(Target.Value) Then
If Target.Value = 1 Then
ActiveSheet.Shapes("Rounded Rectangle 4").Fill.ForeColor.RGB = vbRed
ElseIf Target.Value < 1 And Target.Value > 1 Then
ActiveSheet.Shapes("Rounded Rectangle 4").Fill.ForeColor.RGB = vbYellow
Else
ActiveSheet.Shapes("Rounded Rectangle 4").Fill.ForeColor.RGB = vbBlue
End If
End If
End Sub
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Try code based on below:-
Add code for with extra Shapes as required
NB:-To add code Right click shape and select "Assign Macro"

Code:
[COLOR="Navy"]Sub[/COLOR] colshp()
[COLOR="Navy"]Dim[/COLOR] shp [COLOR="Navy"]As[/COLOR] Shape
 [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] shp [COLOR="Navy"]In[/COLOR] ActiveSheet.Shapes
  If shp.Type = 1 Then '[COLOR="Green"][B]msoShapeRoundedRectangle Then[/B][/COLOR]
    [COLOR="Navy"]If[/COLOR] Application.Caller = shp.Name [COLOR="Navy"]Then[/COLOR]
        shp.Fill.ForeColor.SchemeColor = 3
     [COLOR="Navy"]Else[/COLOR]
        shp.Fill.ForeColor.SchemeColor = 4
    [COLOR="Navy"]End[/COLOR] If
 [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

[COLOR="Navy"]Sub[/COLOR] RoundedRectangle1_Click()
colshp
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

[COLOR="Navy"]Sub[/COLOR] RoundedRectangle2_Click()
colshp
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

[COLOR="Navy"]Sub[/COLOR] RoundedRectangle3_Click()
colshp
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

[COLOR="Navy"]Sub[/COLOR] RoundedRectangle4_Click()
colshp
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
So although the above code works perfectly, is there a way of making it work for sets or groups of buttons?
eg i have 3 seperate groups of buttons that will have 1 button in each group highlighted which will
identify the data that is shown.
 
Upvote 0
Try something based on below:-
NB:- The code show 2 sets of 3 shapes !!
NB:- I found it is better to do a "Assign Macro" for each shape before you right Click and "Group" them.
Sometimes with these shapes you get a "Cannot find "Macro" or similar problems.
Code:
[COLOR="Navy"]Sub[/COLOR] RoundedRectangle9_Click()
GetCol
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

[COLOR="Navy"]Sub[/COLOR] RoundedRectangle10_Click()
GetCol
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

[COLOR="Navy"]Sub[/COLOR] RoundedRectangle8_Click()
GetCol
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

[COLOR="Navy"]Sub[/COLOR] RoundedRectangle25_Click()
GetCol
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

[COLOR="Navy"]Sub[/COLOR] RoundedRectangle26_Click()
GetCol
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

[COLOR="Navy"]Sub[/COLOR] RoundedRectangle27_Click()
GetCol
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

[COLOR="Navy"]Sub[/COLOR] GetCol()
[COLOR="Navy"]Dim[/COLOR] Shp [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] pShp [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Set[/COLOR] pShp = ActiveSheet.Shapes(Application.Caller).ParentGroup
 [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Shp [COLOR="Navy"]In[/COLOR] pShp.GroupItems
  [COLOR="Navy"]If[/COLOR] Shp.Type = 1 [COLOR="Navy"]Then[/COLOR]
    [COLOR="Navy"]If[/COLOR] Application.Caller = Shp.Name [COLOR="Navy"]Then[/COLOR]
        Shp.Fill.ForeColor.SchemeColor = 3
     [COLOR="Navy"]Else[/COLOR]
        Shp.Fill.ForeColor.SchemeColor = 4
    [COLOR="Navy"]End[/COLOR] If
 [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,557
Messages
6,114,287
Members
448,562
Latest member
Flashbond

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top