[AccessD] CommandBarControl subitems

CommandBars are very strange beasts.  I ran into some strange stuff when
I converted the ErrorHandler to A2K VBE.  I wanted a submenu off of the
Add-Ins menu, and then several items off that submenu.  It turns out a
submenu is handled slightly differently than a parent menu.  It also
turns out that the object model treats commandbars and toolbars almost
exactly the same, and they are both treated as controls.  Note the
CommandBarControl object has a FindControl method.  Here's some of the
code from the ErroHandler add-in to demonstrate this:

Private Function CBDoesCBCtlExist(strCBarName As String, _
	strCtlName As String) As Boolean
    Dim ctl As CommandBarControl
    
    Set ctl = appCurrent.CommandBars(strCBarName).FindControl(, , _
	strCtlName)
    If ctl Is Nothing Then
        CBDoesCBCtlExist = False
    Else
        CBDoesCBCtlExist = True
    End If
    
End Function

This function is a variation on that found in the ODE samples library,
which looks like this:

Private Function CBDoesCBExist(strCBarName As String) As Boolean

    Dim cbrBar As CommandBar
    
    On Error Resume Next
    
    Set cbrBar = appCurrent.CommandBars(strCBarName)
    If Err = 0 Then
        CBDoesCBExist = True
    Else
        CBDoesCBExist = False
    End If
End Function

I used both in various places, although both are probably not needed. 
When initializing the whole thing, I create both the add-in submenu and
the toolbar first, and then add sub-items later.  Here's the code for
that:

Public Const conMenuName = "Add-Ins"
Public Const conSubMenuName = "C2DbFrameWizMenu"
Public Const conTBarName = "C2DbFrameWiz"

Function InitCommandBars() As Boolean
    Dim cbrMenu As CommandBar
    Dim cbrTbar As CommandBar
    Dim ctlCBarCtl As Office.CommandBarControl
    
    'Set up the toolbar first
    If CBDoesCBExist(conTBarName) = False Then
        Set cbrTbar = appCurrent.CommandBars.Add(conTBarName)
        cbrTbar.Position = msoBarTop
        cbrTbar.Visible = True
    End If

    'Set up the Add-in submenu next
    On Error Resume Next
    Set cbrMenu = appCurrent.CommandBars(conMenuName)
    Set ctlCBarCtl = cbrMenu.Controls(conSubMenuName)
    If Err <> 0 Then
        Err.Clear
        Set ctlSubMenu = cbrMenu.Controls.Add(msoControlPopup)
        ctlSubMenu.Caption = "&" & conTBarName
    End If
    
    If Err = 0 Then InitCommandBars = True Else InitCommandBars = False

End Function

Note that in this case, appCurrent is a global pointer to the current
instance of the VBIDE object.  If you just want it for Access, I think
you can just use the built-in Application object.

So once the "parent" commandbars are initialized, I add the menu items
using the following code:

Function AddCommandBarControl(strCommandBarName As String, _
    strControlName As String, strControlCaption As String, _
    strAction As String, intResBitmap As Integer, _
    Optional bAddToSubMenu As Boolean = False, _
    Optional lngType As Long = 1, Optional lngStyle As Long = 3, _
    Optional strShortcut As String = "") As Office.CommandBarButton
    
 On Error Resume Next
 
    Dim cbrNew          As Object
    Dim ctlCBarControl  As Office.CommandBarButton
    
    ' Toolbars are handled slightly differently from menubars,
    '   so set a parent object here
    If bAddToSubMenu Then
        Set cbrNew = ctlSubMenu
    Else
        Set cbrNew = appCurrent.CommandBars(strCommandBarName)
    End If
    
    ' Only add the control if it's not there already
    If CBDoesCBCtlExist(strCommandBarName, strControlName) = False Then
        With cbrNew
            Clipboard.SetData LoadResPicture(intResBitmap, _
		vbResBitmap), vbCFBitmap
            Set ctlCBarControl = .Controls.Add(lngType)
            With ctlCBarControl
                .Tag = strControlName
                .Caption = strControlCaption
                .PasteFace
                .Style = lngStyle
                .OnAction = strAction
                If Len(strShortcut) > 0 Then .ShortcutText = strShortcut
            End With
        End With
    End If
    
    Set AddCommandBarControl = ctlCBarControl
    
End Function

The Init function andt his function are called when the add-in is
activated (when the VBE IDE starts up).  Here's an excerpt from that:

' Constants for characters surrounding ProgID.
Public Const PROG_ID_START As String = "!<"
Public Const PROG_ID_END As String = ">"

If InitCommandBars Then         'If we were successful in creating the commandbars
   'Create the error handler toolbar buttons
    Set ctlTBarErrHndlrEvents = AddCommandBarControl(conTBarName, _
       "ErrHndlrBldr", "&Error Handler", PROG_ID_START & _
       AddInInst.ProgId & PROG_ID_END, conResBmpErr)
' skip a bunch more of these

   'Create the error handler menu bar selection
    Set ctlMenuErrHndlrEvents = AddCommandBarControl( _
        conSubMenuName, "ErrHndlrBldrMenu", "&Error Handler", _
        PROG_ID_START & AddInInst.ProgId & PROG_ID_END, _
        conResBmpErr, True, , , "Ctrl+Shift+Z")
' skip a bunch more of these
End If

Some of this isn't totally relevant, but I hope it will give you an idea
of what's involved at the level of creating commandbars and commandbar
items.

Seth

On Mon, 2003-04-07 at 14:47, Susan Harkins wrote:
> If a CommandBarControl on a menu bar contains submenus, how do I cycle
> through that control's collection to list the submenus? This is driving me
> nuts -- I can't figure out how to reference a control's Collection -- does a
> control have a collection? I'm assuming it does if there are submenus?????
> 
> 
> Dim cbarMenu As CommandBar
>   Dim cbarControl As CommandBarControl
>   Dim cbarSub As CommandBarControl
>   'Dim cbarcolControls As CommandBarControls
>   Set cbarMenu = CommandBars(barname)
>   For Each cbarControl In cbarMenu.Controls
>     If cbarControl.Id = controlname Then
>       For Each control in cbarControl's collection...
> 
> 
> This is where I get lost -- at this point, I need to declare cbarControl's
> collection, and I can't get it.
> 
> 
> Susan H.
> 

-- 
Seth Galitzer			sgsax at ksu.edu
Computing Specialist		http://puma.agron.ksu.edu/~sgsax
Dept. of Plant Pathology
Kansas State University