Change ActiveX Command button color back to previous color after clicked

问题

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

回答1:

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.

回答2:

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

' --------------------------------------------------------------------------------------

来源：https://stackoverflow.com/questions/46381935/change-activex-command-button-color-back-to-previous-color-after-clicked

标签

excel

vba

commandbutton