クリックした後、ActiveXコマンドボタンの色を前の色に戻します。

Question

私は65を超えるActiveXコマンドボタンを備えたスプレッドシートを持っています。 1つのコマンドボタンをクリックすると、緑色に変わり、セルに（+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の代わりに1つの場所を変更する必要があります。抽象化レベル、すなわち別個の専用の手順で機能を実装することによって実現される。

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")にあなたがstatsSheet（または類似）の(Name)を与えるお勧めします - あなたはすでに使用している方法を毎回Worksheetsコレクションからフェッチするのではなく、既存のワークシートオブジェクトを削除します。ここ

Answer 2

は、ワークシート

上のすべてのボタン1つだけのイベントハンドラを使用するには、いくつかのデモコードです。シートモジュール

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

Private Sub Worksheet_Activate() 
    activateButtons 
End Sub 

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

にこれを入れて、これはワークシート

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

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 moduleにこれを入れ

は、モジュールにこれを入れます

makeButtonsは

activateButtonsあなたはそのコードを70回複製したクラスのイベントハンドラ

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

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 

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