单击后将 ActiveX 命令按钮颜色更改回以前的颜色
Change ActiveX Command button color back to previous color after clicked
我有一个包含超过 65 个 ActiveX 命令按钮的扩展sheet。当我左键单击一个命令按钮时，它变为绿色并在单元格中添加 (+1)。当我右键单击同一个命令按钮时，它变成红色并在单元格中添加 (+1)。
当我单击另一个命令按钮时，我想 return 将前一个命令按钮恢复为默认灰色。问题是前一个命令按钮的颜色与我之前单击的颜色相同。
当 sheet 上有超过 65 个命令按钮时，如何使单击的命令按钮 return 恢复为默认灰色。到目前为止，这是我对单个命令按钮的了解：
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 个命令按钮 returns 变为默认灰色，以便颜色仅针对单击的按钮更改。你有什么建议吗？
谢谢
这是大量的复制粘贴和重复代码。您将希望减少重复，以便在您需要按钮执行其他操作（或只是更改配色方案）的那一天，您可以更改一个位置而不是 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
如果可能的话，我强烈建议您给 Worksheets("Stats") 一个 (Name) 的 statsSheet（或类似） - 这样您就可以使用已经存在的工作表对象而不是每次都从 Worksheets 集合中获取它。
这里有一些演示代码，仅对作品中的所有按钮使用一个事件处理程序sheet
.
将其放入名为 BtnClass
的 class module
这是工作中所有按钮的事件处理程序sheet
' --------------------------------------------------------------------------------------
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
' --------------------------------------------------------------------------------------
将其放入 sheet 模块
' --------------------------------------------------------------------------------------
Private Sub Worksheet_Activate()
activateButtons
End Sub
' --------------------------------------------------------------------------------------
将其放入模块
makeButtons 在工作中创建一堆按钮sheet
activateButtons 将按钮附加到 class 事件处理程序
' --------------------------------------------------------------------------------------
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
' --------------------------------------------------------------------------------------
我有一个包含超过 65 个 ActiveX 命令按钮的扩展sheet。当我左键单击一个命令按钮时，它变为绿色并在单元格中添加 (+1)。当我右键单击同一个命令按钮时，它变成红色并在单元格中添加 (+1)。
当我单击另一个命令按钮时，我想 return 将前一个命令按钮恢复为默认灰色。问题是前一个命令按钮的颜色与我之前单击的颜色相同。
当 sheet 上有超过 65 个命令按钮时，如何使单击的命令按钮 return 恢复为默认灰色。到目前为止，这是我对单个命令按钮的了解：
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 个命令按钮 returns 变为默认灰色，以便颜色仅针对单击的按钮更改。你有什么建议吗？
谢谢
这是大量的复制粘贴和重复代码。您将希望减少重复，以便在您需要按钮执行其他操作（或只是更改配色方案）的那一天，您可以更改一个位置而不是 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
如果可能的话，我强烈建议您给 Worksheets("Stats") 一个 (Name) 的 statsSheet（或类似） - 这样您就可以使用已经存在的工作表对象而不是每次都从 Worksheets 集合中获取它。
这里有一些演示代码，仅对作品中的所有按钮使用一个事件处理程序sheet
.
将其放入名为 BtnClass
class module
这是工作中所有按钮的事件处理程序sheet
' --------------------------------------------------------------------------------------
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
' --------------------------------------------------------------------------------------
将其放入 sheet 模块
' --------------------------------------------------------------------------------------
Private Sub Worksheet_Activate()
activateButtons
End Sub
' --------------------------------------------------------------------------------------
将其放入模块
makeButtons 在工作中创建一堆按钮sheet
activateButtons 将按钮附加到 class 事件处理程序
' --------------------------------------------------------------------------------------
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
' --------------------------------------------------------------------------------------