Question

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

当我单击另一个命令按钮时，我想将上一个命令按钮返回到默认灰色。问题是前一个命令按钮保持与我之前单击的颜色相同。

当工作表上有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

我有它可以将颜色改为红色或绿色，当它被右击或左击时。但是当我点击另一个按钮时，我不知道如何将其更改为默认灰色。

基本上，当我点击＆＃39;动作69＆＃39;命令按钮，＆＃39; Action68＆＃39;命令按钮以及其他67个命令按钮，返回默认灰色，以便仅为单击的按钮更改颜色。你有什么建议吗？

谢谢

Answer 1

这是很多复制粘贴和重复的代码。您需要减少重复，以便在需要按钮执行其他操作的那一天（或只是更改颜色方案）时，您可以更改一个地方而不是70.

您可以通过提高抽象级别来实现这一点，即通过在单独的专用过程中实现功能。

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

现在你的处理程序看起来像这样：

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

我强烈建议您尽可能(Name) statsSheet Worksheets("Stats")（或类似）给Worksheets - 这样您就可以使用现有的工作表对象而不是获取它每次都来自Query集合。

Answer 2

这里有一些演示代码，只对工作表上的所有按钮使用一个事件处理程序

将其放入名为class module

的BtnClass中

这是工作表上所有按钮的事件处理程序

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

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

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

将其放入工作表模块

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

Private Sub Worksheet_Activate()
    activateButtons
End Sub

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

将其放入模块

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

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

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

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

2 个答案: