I have a spreadsheet with over 65 ActiveX Command Buttons. When I left click one command button, it turns green and add a (+1) in a cell. When I right click the same command button, it turns red and add a (+1) in a cell.
When I click another command button, I want to return the previous command button back to the default grey. The issue is that the previous command button remains the same color as I previous clicked.
How do I make the command button that was clicked, return back to default grey, when there are 65+ command buttons on a sheet. Here is what I have so far for a single command button:
Private Sub Action68_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then
Worksheets("Stats").Cells(CurrentPlayerRow, "BA").Value = Worksheets("Stats").Cells(CurrentPlayerRow, "BA").Value + 1
Action68.BackColor = vbGreen
ElseIf Button = 2 Then
Worksheets("Stats").Cells(CurrentPlayerRow, "BB").Value = Worksheets("Stats").Cells(CurrentPlayerRow, "BB").Value + 1
Action68.BackColor = vbRed
End If
End Sub
Private Sub Action69_MouseDown(ByVal Button As Integer, ByVal Shift As
Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then
Worksheets("Stats").Cells(CurrentPlayerRow, "BT").Value = Worksheets("Stats").Cells(CurrentPlayerRow, "BT").Value + 1
Action69.BackColor = vbGreen
ElseIf Button = 2 Then
Worksheets("Stats").Cells(CurrentPlayerRow, "BU").Value = Worksheets("Stats").Cells(CurrentPlayerRow, "BU").Value + 1
Action69.BackColor = vbRed
End If
End Sub
I have it where it changes the color to red or green, when it is right or left clicked. But I do not know how to make it change to a default grey, when another button is clicked.
Basically, When I click the 'Action 69' command button, the 'Action68' command button along with the other 67 command buttons, returns to a default grey, so that the color changes only for the button that is clicked. Do you have any suggestions?
Thank you
That's a lot of copy-paste and duplicated code. You will want to reduce that duplication so that the day you need the buttons to do something else (or just to change the color scheme), you have one place to change instead of 70.
You do that by increasing the abstraction level, i.e. by implementing the functionality in a separate, dedicated procedure.
Public Enum ButtonState
LeftButton = 1
RightButton = 2
End Enum
Private Sub HandleControlClick(ByVal axControl As MSForms.Control, ByVal column As String, ByVal state As ButtonState)
Const defaultColor As Long = &H8000000F&
Dim newColor As Long, columnOffset As Long
Select Case state
Case LeftButton
newColor = vbRed
Case RightButton
newColor = vbGreen
columnOffset = 1
Case Else
newColor = defaultColor
End Select
axControl.BackColor = newColor
StatsSheet.Cells(CurrentPlayerRow, column).Offset(0, columnOffset).Value = StatsSheet.Cells(CurrentPlayerRow, column).Offset(0, columnOffset).Value + 1
End Sub
And now your handlers can look like this:
Private Sub Action68_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
HandleControlClick ActiveSheet.OleObjects("Action68").Object, Button, "BA"
End Sub
Private Sub Action69_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
HandleControlClick ActiveSheet.OleObjects("Action69").Object, Button, "BT"
End Sub
I'd warmly recommend you give a (Name)
of statsSheet
(or similar) to your Worksheets("Stats")
if possible - that way you use an already-existing worksheet object instead of fetching it from the Worksheets
collection every time.
here is some demo code to use only one event handler for all of the buttons on a worksheet
.
put this into class module
named BtnClass
this is an event handler for all the buttons on the worksheet
' --------------------------------------------------------------------------------------
Option Explicit
Public WithEvents ButtonGroup As MSForms.CommandButton
Private Sub ButtonGroup_Click()
Dim msg As String
msg = "clicked : " & ButtonGroup.Name & vbCrLf _
& "caption : " & ButtonGroup.Caption & vbCrLf _
& "top : " & ButtonGroup.Top & vbCrLf _
& "left : " & ButtonGroup.Left
Debug.Print ButtonGroup.Name; vbNewLine; msg
End Sub
Private Sub ButtonGroup_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
Debug.Print "down", Button, ButtonGroup.Name
If Button = 1 Then
ButtonGroup.BackColor = vbRed
ButtonGroup.TopLeftCell.Offset(0, 3).Interior.Color = vbBlue
Else
ButtonGroup.BackColor = vbGreen
ButtonGroup.TopLeftCell.Offset(0, 3).Interior.Color = vbYellow
End If
End Sub
Private Sub ButtonGroup_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
Debug.Print "up", ButtonGroup.Name
ButtonGroup.BackColor = &H8000000F
End Sub
' --------------------------------------------------------------------------------------
put this into the sheet module
' --------------------------------------------------------------------------------------
Private Sub Worksheet_Activate()
activateButtons
End Sub
' --------------------------------------------------------------------------------------
put this into module
makeButtons
creates a bunch of buttons on worksheet
activateButtons
attaches the buttons to the class event handler
' --------------------------------------------------------------------------------------
Option Explicit
Dim Buttons() As New BtnClass
Const numButtons = 20
'
Sub doButtons()
makeButtons ' does not work reliably ... buttons out of sequence
activateButtons ' does not activate reliably (run these separately instead)
End Sub
Sub makeButtons() ' creates a column of commandButtons
Dim sht As Worksheet
Set sht = ActiveSheet
Dim i As Integer
For i = 1 To sht.Shapes.Count
' Debug.Print sht.Shapes(1).Properties
sht.Shapes(1).Delete
DoEvents
Next i
Dim xSize As Integer: xSize = 2 ' horizontal size (number of cells)
Dim ySize As Integer: ySize = 2 ' vertical size
Dim t As Range
Set t = sht.Range("d2").Resize(ySize, xSize)
For i = 1 To numButtons
sht.Shapes.AddOLEObject Left:=t.Left, Top:=t.Top, Width:=t.Width, Height:=t.Height, ClassType:="Forms.CommandButton.1"
DoEvents
Set t = t.Offset(ySize)
Next i
End Sub
Sub activateButtons() ' assigns all buttons on worksheet to BtnClass.ButtonGroup
Dim sht As Worksheet
Set sht = ActiveSheet
ReDim Buttons(1 To 1)
Dim i As Integer
For i = 1 To sht.Shapes.Count
ReDim Preserve Buttons(1 To i)
Set Buttons(i).ButtonGroup = sht.Shapes(i).OLEFormat.Object.Object
Next i
End Sub
' --------------------------------------------------------------------------------------