WEBINAR: On-demand webcast
How to Boost Database Development Productivity on Linux, Docker, and Kubernetes with Microsoft SQL Server 2017 REGISTER >
This is written in VB help files
private withevents ce as CommandBarEvents ' Sub Test() Dim c as CommandBarControl set c = Application.VBE.CommandBars("Menu Bar").Controls(2) set ce = Application.VBE.Events.CommandBarEvents(c) End Sub ' private Sub ce_Click(byval CommandBarControl as Object, _ Handled as Boolean, CancelDefault as Boolean) ' Put event-handling code here End Sub '
How this works
This class ctlCmdEvent can act both as ParentClass and ChildClass.
SetEvents method collects all CommandBarControls and creates a new ChildClass for each control. This ChildClass is able to get its control event (Click). ChildClass directs the event back to ParentClass which rises event back to the first user object.
With Visual Basic 6 create a new Add-In project and modify the created designer code to read like the following :
option Explicit ' private withevents mCmdEvent as clsCmdEvent 'to catch all command 'button events '------------------------------------------------------ 'this method adds the Add-In to VB '------------------------------------------------------ private Sub AddinInstance_OnConnection(byval Application as Object, _ byval ConnectMode as AddInDesignerObjects.ext_ConnectMode, _ byval AddInInst as Object, custom() as Variant) ' on error GoTo error_handler ' 'save the vb instance set VBInstance = Application ' 'Initialize every CommandBar Events from VB set mCmdEvent = new clsCmdEvent mCmdEvent.SetEvents VBInstance ' ' ............. Exit Sub ' error_handler: ' MsgBox Err.Description ' End Sub '------------------------------------------ ' This event raises for every commandbar button click '------------------------------------------ private Sub mCmdEvent_Click(byval CommandBarControl as Object, _ Handled as Boolean, CancelDefault as Boolean) ' 'place your handling code here ' Dim CB as CommandBarControl set CB = CommandBarControl ' Select Case CB.Parent.Name & CB.Id Case "Standard186" 'Run Command Button End Select With CB MsgBox "VB Command:" & vbCrLf & _ "Parent: " & .Parent.Name & vbCrLf & _ "Id: " & .Id & vbCrLf & _ "Index:" & .Index & vbCrLf & _ "Type: " & .Type & vbCrLf & _ "Caption: " & .Caption & vbCrLf & _ "Description: " & .DescriptionText End With ' End Sub ' '
Source code for a class clsCmdEvent
Create a new Class and name it as clsCmdEvent and paste following code there:
'================================================= ' Class clsCmdEvent: '==================== ' Raises all VB-CommandBar Click events to upper level ' by Toby 1999-08-17 ' ' email@example.com ' ' This class is used as parent and its own child ' When used as Parent, it carries its babies ' and raises their events to its own parent ' ' When used as child it just tells (not raises) ' to m_Parent when someone is pushing ' '================================================= ' ' Add the following to Connection Designer ...... ' '================================================= ' Declarations ' ' private withevents CmdEvent as clsCmdEvent '================================================ ' '================================================ ' to Prepare Events ' ' private Sub AddinInstance_OnStartupComplete(Custom() as Variant) ' ' set CmdEvent = new clsCmdEvent ' CmdEvent.SetEvents VBInstance ' ..... ' End Sub '================================================ ' ' '================================================ ' And event fires ' 'private Sub CmdEvent_Click(byval CommandBarControl as Object, _ ' Handled as Boolean, CancelDefault as Boolean) ' Dim cb as CommandBarControl ' set cb = CommandBarControl ' Debug.print cb.Caption, cb.Id, cb.m_Parent.Name 'End Sub '================================================ ' ' ???????????????????????????????????????????????? ' ' If You find out how to get menu_Clicks from VB-MenuBar ' and for example Project Pane and Project Properties window ' changes please let me know! ' ' I am interest in everything within AddIns ' ' firstname.lastname@example.org ' ???????????????????????????????????????????????? ' ' ' '================================================ ' Add a Class named clsCmdEvent and copy the ' following to it '================================================ ' option Explicit ' private m_EventClasses as Collection 'store for 'next level classes private m_Parent as clsCmdEvent '"Upper me" when 'called recursively 'as child private withevents m_BarEvents as VBIDE.CommandBarEvents ' public BarControl as Office.CommandBarControl public Event Click(byval CommandBarControl as Object, _ Handled as Boolean, CancelDefault as Boolean) '================================================= ' Collect ActiveBar or All CommandBars '================================================= public Sub SetEvents(byval VBInstance as VBIDE.VBE, _ optional byval OnlyActiveBar as Boolean = false) on error GoTo ErrH ' Dim mCommandBar as CommandBar Dim mCommandBarControl as CommandBarControl ' set m_EventClasses = new Collection ' If OnlyActiveBar then SetEventsBar VBInstance, VBInstance.CommandBars.ActiveMenuBar else for Each mCommandBar In VBInstance.CommandBars SetEventsBar VBInstance, mCommandBar next End If ' Exit Sub ' ErrH: ' MsgBox Err.Number & " " & Err.Description & _ " while collecting CommandBar" Err.Raise Err.Number, Err.Source, Err.Description, _ Err.HelpFile, Err.HelpContext ' End Sub '================================================= ' Collect CommandBar Controls for Child '================================================= private Sub SetEventsBar(byval VBInstance as VBIDE.VBE, _ byval mCommandBar as CommandBar) ' Dim mCommandBarControl as CommandBarControl Dim newCmdEvent as clsCmdEvent ' '.. create children for raising event ' for Each mCommandBarControl In mCommandBar.Controls set newCmdEvent = new clsCmdEvent newCmdEvent.SetBarControl me, VBInstance, _ mCommandBarControl m_EventClasses.Add newCmdEvent next ' End Sub '================================================= ' sink the event when used as Child '================================================= public Sub SetBarControl(byval nm_Parent as clsCmdEvent, _ byval VBInstance as VBIDE.VBE, byval CommandBarControl _ as CommandBarControl) ' set m_Parent = nm_Parent set BarControl = CommandBarControl set m_BarEvents = _ VBInstance.Events.CommandBarEvents(CommandBarControl) ' End Sub '================================================= ' clear me '================================================= private Sub Class_Terminate() ' set m_EventClasses = nothing set BarControl = nothing set m_BarEvents = nothing ' End Sub '================================================= ' gets the event when used as Child and ' tell to m_Parent that You pushed me '================================================= private Sub m_BarEvents_Click(byval CommandBarControl _ as Object, _ Handled as Boolean, CancelDefault as Boolean) ' If Not m_Parent is nothing then _ m_Parent.CmdClick CommandBarControl, Handled, CancelDefault ' End Sub '================================================= ' Raise the event to topmost caller '================================================= public Sub CmdClick(byval CommandBarControl as Object, _ Handled as Boolean, CancelDefault as Boolean) ' RaiseEvent Click(CommandBarControl, Handled, CancelDefault) ' End Sub ' '