Command button Array

AlexanderBB

Well-known Member
Joined
Jul 1, 2009
Messages
1,705
I'm wanting what I think would be a Command Button Control Array.
Where a number of buttons can share a common click event and pass something to identify which button was clicked.

I found this via Google

Code:
    Private arCommandButton(1 To 3) As New Class1
     
    Private Sub init()
        Set arCommandButton(1).ButtonEvents = cmd1
        arCommandButton(1).Index = 1
        Set arCommandButton(2).ButtonEvents = cmd2
        arCommandButton(2).Index = 2
        Set arCommandButton(3).ButtonEvents = cmd3
        arCommandButton(3).Index = 3
    End Sub
     
    'In a Class Module
    Public WithEvents ButtonEvents As MSForms.CommandButton
    Public Index As Integer
     
    Private Sub ButtonEvents_Click()
        MsgBox "Button clicked.  The Index is: " & Index
    End Sub

However I can't get this to work. Perhaps something is missing?
Any help with this or alternative method appreciated.
Thanks
 

Some videos you may like

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

Jeffrey Mahoney

Well-known Member
Joined
May 31, 2015
Messages
1,768
Could you not use a simple method like this:

In the sheet level
Code:
Private Sub CommandButton1_Click()
  Call ButtonPress(1)
End Sub

Private Sub CommandButton2_Click()
  Call ButtonPress(2)
End Sub

In a standard module
Code:
Sub ButtonPress(BtnNum)
  
  Select Case BtnNum
    Case 1
      'Some code
    Case 2
      'some more code
    Case 3
      'Even more
  End Select
End Sub
 

AlexanderBB

Well-known Member
Joined
Jul 1, 2009
Messages
1,705
Thanks. That would work, yes, but I'd still need 48 individual (there's 48 buttons used as colour picker) click events.
I'm sure I had a solution (way above my code ability) but I can't find it now. It did it as one click event and the setup was very small too.
 

Jeffrey Mahoney

Well-known Member
Joined
May 31, 2015
Messages
1,768
If your looking for a color picker, I found this from here:
https://vba-corner.livejournal.com/1691.html

The TestColorPicker is just my input to see how it worked. This uses a dialog for the user to select any color and returns the results. I like it!

What do you think?

Jeff


Code:
Sub testcolorpicker()
  Dim Red As Integer
  Dim Green As Integer
  Dim Blue As Integer
  Dim ChosenColor As Long
  
  ChosenColor = PickNewColor
  Color2RGB ChosenColor, Red, Green, Blue
  MsgBox "Red: " & Red & vbLf & "Green: " & Green & vbLf & "Blue: " & Blue
  
  
End Sub




'Picks new color
Function PickNewColor(Optional i_OldColor As Double = xlNone) As Double
  Const BGColor As Long = 13160660  'background color of dialogue
  Const ColorIndexLast As Long = 32 'index of last custom color in palette
  
  Dim myOrgColor As Double          'original color of color index 32
  Dim myNewColor As Double          'color that was picked in the dialogue
  Dim myRGB_R As Integer            'RGB values of the color that will be
  Dim myRGB_G As Integer            'displayed in the dialogue as
  Dim myRGB_B As Integer            '"Current" color
    
    'save original palette color, because we don't really want to change it
    myOrgColor = ActiveWorkbook.Colors(ColorIndexLast)
    
    If i_OldColor = xlNone Then
      'get RGB values of background color, so the "Current" color looks empty
      Color2RGB BGColor, myRGB_R, myRGB_G, myRGB_B
    Else
      'get RGB values of i_OldColor
      Color2RGB i_OldColor, myRGB_R, myRGB_G, myRGB_B
    End If
    
    'call the color picker dialogue
    If Application.Dialogs(xlDialogEditColor).Show(ColorIndexLast, _
       myRGB_R, myRGB_G, myRGB_B) = True Then
      '"OK" was pressed, so Excel automatically changed the palette
      'read the new color from the palette
      PickNewColor = ActiveWorkbook.Colors(ColorIndexLast)
      'reset palette color to its original value
      ActiveWorkbook.Colors(ColorIndexLast) = myOrgColor
    Else
      '"Cancel" was pressed, palette wasn't changed
      'return old color (or xlNone if no color was passed to the function)
      PickNewColor = i_OldColor
    End If
End Function


'Converts a color to RGB values
Sub Color2RGB(ByVal i_Color As Long, _
  o_R As Integer, o_G As Integer, o_B As Integer)
  o_R = i_Color Mod 256
  i_Color = i_Color \ 256
  o_G = i_Color Mod 256
  i_Color = i_Color \ 256
  o_B = i_Color Mod 256
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,109,461
Messages
5,528,916
Members
409,847
Latest member
Foster034
Top