单击后将ActiveX命令按钮颜色更改回以前的颜色

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.

我有一个包含超过65个ActiveX命令按钮的电子表格。当我左键单击一个命令按钮时,它变为绿色并在单元格中添加(+1)。当我右键单击相同的命令按钮时,它变为红色并在单元格中添加(+1)。

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:

当工作表上有65个以上的命令按钮时,如何制作单击的命令按钮,返回默认灰色。这是我到目前为止的单个命令按钮:

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?

基本上,当我单击“Action 69”命令按钮时,“Action68”命令按钮以及其他67个命令按钮将返回默认灰色,以便颜色仅针对单击的按钮进行更改。你有什么建议吗?

Thank you

2 个解决方案

#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.

这是很多复制粘贴和重复的代码。您将希望减少该重复,以便您需要按钮执行其他操作的那一天(或只是更改颜色方案),您有一个地方可以更改而不是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.

我强烈建议您在可能的情况下为工作表(“统计信息”)提供(名称)statsSheet(或类似) - 这样您就可以使用已存在的工作表对象,而不是每次从Worksheets集合中获取它。

#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

把它放到名为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

makeButtons在工作表上创建了一堆按钮

activateButtons attaches the buttons to the class event handler

activateButtons将按钮附加到类事件处理程序

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

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

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

#1