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

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

excel vba

Excel 单击后将ActiveX命令按钮颜色更改回以前的颜色,excel,vba,commandbutton,Excel,Vba,Commandbutton,我有一个超过65个ActiveX命令按钮的电子表格。当我左键单击一个命令按钮时，它变为绿色，并在单元格中添加（+1）。当我右键单击同一个命令按钮时，它将变为红色，并在单元格中添加（+1）当我单击另一个命令按钮时，我希望将上一个命令按钮返回到默认的灰色。问题是“上一个命令”按钮的颜色与我上次单击的相同当工作表上有65个以上的命令按钮时，如何使单击的命令按钮返回默认灰色。到目前为止，我只使用了一个命令按钮： Private Sub Action68_MouseDown(ByVal Button

我有一个超过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

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

基本上，当我单击“Action 69”命令按钮时，“Action 68”命令按钮以及其他67个命令按钮将返回默认灰色，因此颜色仅会更改单击的按钮。你有什么建议吗

谢谢

这是大量的复制粘贴和重复代码。您将希望减少重复，以便在您需要按钮执行其他操作（或只是更改配色方案）的那天，您有一个地方可以更改，而不是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

我强烈建议您在您的

工作表（“Stats”）中提供（名称）
的统计表
（或类似）

如果可能-这样您就可以使用一个已经存在的工作表对象，而不是每次都从

工作表

集合中获取它。

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

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

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

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

将其放入名为

BtnClass的class模块

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

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
在工作表上创建一组按钮
' --------------------------------------------------------------------------------------

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

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

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

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

你把代码复制了70次？您可能想在这里提取一个小的参数化方法。。。FWIWButtonFace
系统默认的BackColor
颜色为&h800000f&
-您可以通过查看属性工具窗口来找到。感谢您的输入。是的，每个按钮都有70次。我不明白你的意思。对不起，我是vba新手。如果单击另一个按钮，是否允许它自动返回到“默认灰色”？使用保存对象（按钮）的全局变量或运行所有按钮。如按钮klicked->将变量中的按钮更改为默认值->执行按钮操作->将变量设置为实际值button@DirkReichelActiveX控件引发事件，每个事件都必须由各自单独的处理程序处理。该解决方案适用于“表单控件”，而不是ActiveX。什么是CurrentPlayerRow
？…或者如果所有代码都在工作表模块中，您可以使用Me
引用工作表。@TimWilliams！