單擊後將ActiveX命令按鈕顏色更改回原來的顏色

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 

我有它的顏色變爲紅色或綠色，當它是左或右點擊。但是當我點擊另一個按鈕時，我不知道如何將它變成默認灰色。

基本上，當我點擊'Action 69'命令按鈕時，'Action68'命令按鈕以及其他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集合中獲取它。

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 

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