One Sub for Multiple Command Buttons (ActiveX Control)

Hello All!

I have too much time on my hands at my new job. This leads to tinkering with things I don't fully understand, which ultimately, has lead to this post. Here is my scenario:

I have a QA checklist for my process. There are 84 rules/test questions. Based on a combination of factors only certain rules/questions apply to a given instance. I have successfully written subs to display only applicable test questions based on the selection of factors. No Problem.

Next, I added Command Buttons from the ActiveX Controls Menu, with subs that display message boxes (MsgBox) containing the rule for each test question. The Rules are on a separate sheet, each with a named range that matches the name of the Command Button. I have successfully written subs to Display, Hide and Move the Command Buttons so that they are visible next to the displayed test questions.

Where I'm at now - I have 84 subs for 84 command buttons. Note in the sample of my 84 subs below that the Sub names Rule3_click() etc., are the names of both the command buttons and the named range where the rule resides, Sheet3.Range("rule3") etc.

Below is a sample of the rudimentary subs I'm using. So question:
- How can I use one sub which is used by all command buttons to identify the name of the button that was clicked, like "Rule3" and display in the message box, the rule in the named range, like "Rule3", that matches the name of the command button?

Private Sub Rule3_Click()
'Displays a message box with the rules related to the test question
Dim Range1 As Range
Set Range1 = Sheet3.Range("Rule3")
MsgBox (Range1)
End Sub

Private Sub Rule4_Click()
'Displays a message box with the rules related to the test question
Dim Range1 As Range
Set Range1 = Sheet3.Range("Rule4")
MsgBox (Range1)
End Sub

Private Sub Rule5_Click()
'Displays a message box with the rules related to the test question
Dim Range1 As Range
Set Range1 = Sheet3.Range("Rule5")
MsgBox (Range1)
End Sub

etc...

Is it necessary to retain 84 subs? It works fine like it is, but I am curious. I have seen on this and other sites, ways to make this work with Buttons from the Forms menu, but I get errors with the ActiveX Command Buttons. Much of the information I have found is very dated though, so perhaps there is something new.

Thanks!

One way to do it would be to use a list box or combobox instead of the message box. You could then use either a Select Case algorithm to distinguish between the user selections of the items in the list/combo box and which range on sheet 3 to access. But I am not going to write the code for you, because you have too much time on your hands already.

Hi Raymundus and welcome to ExcelForum,

One way to do what you want is to use one Class Event Handler to process all your CommandButtons. See the attached file which contains the following code for a simple example using 4 CommandButtons.

In Class Module ClassButtonEvent (The Name of the module must be ClassButtonEvent or changes to the code are required):

Option Explicit

'This code is based on code from Andy Pope (Thank you Andy)
'http://www.excelforum.com/excel-programming-vba-macros/1021112-call-userform-from-a-variable-number-of-activex-command-buttons.html

Public WithEvents myCommandButton As MSForms.CommandButton

Private Sub myCommandButton_Click()
  'This is the Active X Event Handler
  
  MsgBox "Clicked " & Me.myCommandButton.Name & " " & Me.myCommandButton.Caption
End Sub

In an ordinary code module:

Option Explicit

'This code is based on code from Andy Pope (Thank you Andy)
'http://www.excelforum.com/excel-programming-vba-macros/1021112-call-userform-from-a-variable-number-of-activex-command-buttons.html

Private Const myCommandButtonCOUNT As Long = 4
Private Const sControlTypeDESCRIPTION As String = "Active X CommandButton"
Private Const sControlType As String = "CommandButton"
Public myCommandButtonEvents As Collection


Sub CreateCommandButtons()
  'This Creates 'Active X' Controls

  Dim Output As Range
  Dim TempButt As OLEObject
  
  Dim iCount As Long
  Dim iIndex As Long
    
  'First Control will be at the 'Top Left' of the following cell
  Set Output = ActiveSheet.Range("B4")
  
  For iIndex = 1 To myCommandButtonCOUNT
  
    'Create the Command Button
    Set TempButt = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
                                              Link:=False, _
                                              DisplayAsIcon:=False, _
                                              Left:=Output.Left, _
                                              Top:=Output.Top, _
                                              Width:=Output.Width * 3, _
                                              Height:=Output.Height * 3)
                                              
    'Create the 'Caption' for each CommandButton
    TempButt.Object.Caption = "Active X CommandButton " & iIndex
    
    'Increment the 'Top Left' for the next CommandButton
    Set Output = Output.Offset(4, 0)
    
    'Increment the Control Created Count
    iCount = iCount + 1
  Next
  
  Debug.Print iCount & Format(sControlTypeDESCRIPTION, " @") & " Control(s) were Created."
  
End Sub

Sub IterateThruCommandButtons()
  'This iterates through 'Active X' Controls

  Dim myObject As OLEObject
  Dim iCount As Long

  For Each myObject In ActiveSheet.OLEObjects
    If TypeName(myObject.Object) = "CommandButton" Then
       iCount = iCount + 1
       
       Debug.Print Format(iCount, "000  ") & _
                   Format(myObject.Name, "!@@@@@@@@@@@@@@@@@@  ") & _
                   Format(myObject.Object.Caption, "!@@@@@@@@@@@@@@@@@@@@@@@@@@  ") & _
                   Format(myObject.Top, "@@@@@@@  ") & _
                   Format(myObject.Left, "@@@@@@@  ")

    End If
  Next myObject
  
  If iCount = 0 Then
    Debug.Print "There were NO" & Format(sControlTypeDESCRIPTION, " @") & " CONTROLS to Iterate through."
  End If


End Sub


Sub EnableCommandButtonEvents()
  'This Enables Active X Events (Active X controls must already exist)

  Dim CmdBtnEvents As ClassButtonEvent
  Dim myObject As OLEObject
  
  Dim iCount As Long
  Dim iIndex As Long
    
  'Define the Event Collection
  Set myCommandButtonEvents = New Collection
    
  'Create the Events
  For Each myObject In ActiveSheet.OLEObjects
    
    iIndex = iIndex + 1
  
    If TypeName(myObject.Object) = sControlType Then
      Set CmdBtnEvents = New ClassButtonEvent
      Set CmdBtnEvents.myCommandButton = ActiveSheet.OLEObjects(iIndex).Object
      myCommandButtonEvents.Add CmdBtnEvents, CStr(myCommandButtonEvents.Count + 1)
      iCount = iCount + 1
      If iCount >= myCommandButtonCOUNT Then
        Exit For
      End If
    End If
      
  Next myObject
  
  Debug.Print iCount & Format(sControlTypeDESCRIPTION, " @") & " Control Event(s) were Enabled."
        
End Sub

Sub DisableCommandButtonEvents()
  'This Disables Active X Events
  
  Dim iCount As Long
  Dim iStartingControlEventCount As Long
  
  'Test to see if Controls Exist
  On Error Resume Next
  iStartingControlEventCount = myCommandButtonEvents.Count
  On Error GoTo 0

  'Disable Controls
  If iStartingControlEventCount > 0 Then
    Do While myCommandButtonEvents.Count > 0
      myCommandButtonEvents.Remove 1
      iCount = iCount + 1
    Loop
  End If
  
  Debug.Print iCount & Format(sControlTypeDESCRIPTION, " @") & " Control Event(s) were Disabled."

  'Clear object pointer
  Set myCommandButtonEvents = Nothing
    
End Sub

Sub DeleteCommandButtons()
  'This deletes 'Active X' Controls

  Dim myObject As OLEObject
  Dim iCount As Long

  For Each myObject In ActiveSheet.OLEObjects
    If TypeName(myObject.Object) = sControlType Then
       iCount = iCount + 1
       myObject.Delete
    End If
  Next myObject

  Debug.Print iCount & Format(sControlTypeDESCRIPTION, " @") & " Control(s) were Deleted."

End Sub

Lewis

Thank You! I Did manage to find information on class modules and found a sample of code that works very well. However, I will be incorporating pieces of your code and modifying my approach. As I read your code, the command buttons are created, enabled, collected, disabled and removed, where as my code simply moves and makes visible, buttons that I have inserted for each rule. Here is what I have so far:

class Module:

Public WithEvents ButtonGroup As CommandButton

Private Sub ButtonGroup_Click()
Message = ButtonGroup.Name
Dim Rangeb As Range
Set Rangeb = Sheet3.Range(Message)
MsgBox (Rangeb)
End Sub

Ordinary Module:

Dim Buttons2() As New cButtons

Sub Class_Init()
Dim Sh As Worksheet
Dim Obj As OLEObject
Dim ButtonCount As Integer
For Each Sh In ThisWorkbook.Worksheets
For Each Obj In Sh.OLEObjects
If TypeName(Obj.Object) = "CommandButton" Then
ButtonCount = ButtonCount + 1
ReDim Preserve Buttons2(1 To ButtonCount)
Set Buttons2(ButtonCount).ButtonGroup = Obj.Object
End If
Next Obj
Next Sh
End Sub

While this works quite well, given the time I have, I am going to continue tinkering and see what I can do with the information you provided.

Again, Many Thanks!

Ray

Hi Ray,

I'm glad you got everything to work.

As I read your code, the command buttons are created, enabled, collected, disabled and removed,

The sample file I uploaded is just a software development tool. When I start deveoping a real application, I use all the above features quite often.

When the project is done, the CommandButtons are supposed to be permanent, so I enable on startup and disable when applicable and when the file closed.

-----------------

Please note that Active X controls do not play well with others,and sometimes fail, especially if rows and/or columns get hidden, or when moving the file to another computer. 'Active X' controls' are my 4th choice of tools after:
a. Shapes
b. Forms Controls
c. UserForms

When using 'Active X', I always create the 'Active X' controls using VBA, so if I have an 'Active X' disaster, I can quickly resurrect the file to its original splendor.


Lewis