Creating ShortCut menus using VBA

Are you aware of this tool:

http://www.accessribbon.de/en/

mx

I've never added any images to any of my shortcut menus, so I'm not certain how to do that, but I've attached a code module that I use in several of my applications (some of the stuff will need to be modified because it is particular to my application).  It includes as variety of different shortcut menus which might provide some examples for you.  
 mod-Menus.bas

I've also included a couple of UDFs that the code in the module calls.

HTH
Dale

Public Function FileExists(FileName As String) As Boolean

    On Error GoTo ProcError
    
    FileExists = (Len(Dir(FileName)) > 0)
    Exit Function

ProcError:
    If Err.Number = 52 Then
        Resume Next
    Else
        DisplayError ("Error encountered in FileExists" & vbCrLf & FileName)
    End If
    
End Function
Public Function TableExists(TableName As String, Optional db As DAO.Database) As Boolean

    Dim tdf As DAO.TableDef
    
    If db Is Nothing Then Set db = CurrentDb
    
    TableExists = False
    For Each tdf In db.TableDefs
        If tdf.Name = TableName Then
            TableExists = True
            Exit For
        End If
    Next
    
End Function

Select allOpen in new window

"I've never added any images to any of my shortcut menus,"
It's soooooooooooooooooo easy to do in A2003 and prior.  It's a real shame about this ribbon paradigm.

mx

Ribbons I can create.  I've used the program to the link you sent MX before, but it doesn't do shortcut menus.

When the user right click on certain forms and subforms I am using custom shortcut menus to do certain things.  To include images on these menus fyed, you just have to set the FaceId like in my code above.

Attached is one of my custom Right Click Menus.  But I want to be able to include the submenu like for toggle on my original picture. Any ideas on that?
CustomRightClick.jpg

"but it doesn't do shortcut menus."
Damn.  I was about to download this app.  

"When the user right click on certain forms and subforms I am using custom shortcut menus to do certain things. "
I totally hear you on that, as I have also for many years.  Again, so easy to create in A2003.  The only good news is ... they DO appear untouched in A2010, but ... so far I have not seen a way to modify them in the A2010 environment, which is shameful.  I certainly do NOT want to switch an app back/forth from A2010/A2003 just to make a minor change in a right click menu.

You are positive the deribbon tool won't handle shortcut menus?
What about >> http://www.ribboncreator.de/en/?CommandBars_Converter  ?

mx

All you have to do is add the FaceID: so, where do you find those values?

Now I understand.  You already have the code for creating the first level, you are looking for the code for the second level.  I'll see if I can find that in another one of my applications.

VT,

Check: https://www.experts-exchange.com/questions/10333585/Text-command-bar.html?sfQueryTermInfo=1+10+30+commandbars.add

there is a subfunction in there: Public Function AddSubCmdBarCtl(topCmdBarCtl As CommandBarControl. ,,,

That looks like it might be what you are looking for.

fyed,

You can use this routine below, and it will add all of the FaceIDs to an Add-Ins Tab in Access to give you the FaceID Number.

Just use CreateCommandBarsWithIDs


I'm still looking at the link you suggested to see if it has what I'm looking for... I have been swamped at work.

Function CreateCommandBarsWithIDs()
    Call cbShowButtonFaceIds("CmdIDs_01", 1, 500)
    Call cbShowButtonFaceIds("CmdIDs_02", 501, 1000)
    Call cbShowButtonFaceIds("CmdIDs_03", 1001, 1500)
    Call cbShowButtonFaceIds("CmdIDs_04", 1501, 2000)
End Function

Function cbShowButtonFaceIds(strName As String, _
                             lngIDStart As Long, _
                             lngIDStop As Long)

    Dim cbrNewToolBar As CommandBar
    Dim cmdNewButton As CommandBarButton
    Dim intCntr As Integer

    On Error Resume Next

    ' Delete the CommandBar if it already exists.
    Application.CommandBars(strName).Delete

    ' Create the CommandBar.
    Set cbrNewToolBar = Application.CommandBars.Add( _
                      Name:=strName, temporary:=True)

    ' Loop through the IDs.
    For intCntr = lngIDStart To lngIDStop
        ' Create a new button for each ID.
        Set cmdNewButton = cbrNewToolBar.Controls.Add( _
                         Type:=msoControlButton)

        With cmdNewButton
            .FaceId = intCntr
            .TooltipText = "Faceid= " & intCntr
            .Caption = intCntr
            .Style = msoButtonIconAndCaptionBelow
        End With

        ' This takes awhile to run. Display a count
        ' to indicate progress.
        Debug.Print intCntr & " of " & lngIDStop
    Next intCntr

    ' Display the new CommandBar.
    With cbrNewToolBar
        .Width = 600
        .left = 100
        .Top = 200
        .Visible = True
    End With

    Set cbrNewToolBar = Nothing
    Set cmdNewButton = Nothing
End Function

Select allOpen in new window

I cannot understand this for the life of me.

http://msdn.microsoft.com/en-us/library/aa432141(v=office.12).aspx

This has an example of how to add a msoControlComboBox to a custom menu, and I use the code verbatim and the code runs successfully, but not combo box on my shortcut menu.

This is code I run, which runs successfully:

Public Sub CreateCustomShortcutMenu()
    Dim myBar As Office.CommandBar
    Dim combo As Office.CommandBarControl
    Set myBar = CommandBars.Add(Name:="Custom1", Position:=msoBarPopup, Temporary:=False)

    With myBar
        
        Set combo = .Controls.Add(msoControlButton)
        combo.Caption = "Button 1"
              
        Set combo = .Controls.Add(msoControlButton)
        combo.Caption = "Button 2"
        
        Set combo = .Controls.Add(msoControlButton)
        combo.Caption = "Button 3"
        
        Set combo = .Controls.Add(msoControlComboBox, 1)
        With combo
            .AddItem "First Item", 1
            .AddItem "Second Item", 2
            .DropDownLines = 3
            .DropDownWidth = 75
            .ListIndex = 0
        End With

    Set combo = Nothing
    Set myBar = Nothing
    End With
End Sub

Select allOpen in new window

This is the result:

 

The buttons add correctly, but nothing for the combo box.  


HELP!!!

VT,

I think your problem is that you should have defined button 3 as a combo box instead of a button

Attached is some code I used in a A2K database a few years ago.

Set cbrCombo1 = cbr.Controls.Add(ControlComboBox, , , , True)
With cbrCombo1
    .Caption = "Circular references containing node:"
    .Tag = "Circular References"
    .OnAction = "=fnCircularRef()"
    .DropDownWidth = 70
    .AddItem "Any node"
End With
        
strSQL = "SELECT Node_Num FROM tbl_Nodes ORDER BY Node_Num2"
Set rs = CurrentDb.OpenRecordset(strSQL, , dbFailOnError)
While Not rs.EOF
    cbrCombo1.AddItem rs("Node_Num")
    rs.MoveNext
Wend
rs.Close
Set rs = Nothing

Select allOpen in new window

Then in fnCircularRef, I used the following code to get the index of the item that was selected.

    Set obj = CommandBars("ArcCheckMenu").FindControl(Tag:="Circular References")
    If obj.ListIndex = 0 Then Exit Function

and to get the value of the listindex.

    obj.List(obj.ListIndex)

In my code, I add three buttons, and then add a 4th control that should be the combobox.  But the 4th control doesn't even show up.

you didn't give the 4th control a caption, or a tag (which you will probably need if you actually intend to refer to that control after you select an item from the combo).

This code produces the same result.

3 buttons and no combo box.

Dim myBar As Office.CommandBar
    Dim combo As Office.CommandBarControl
    Set myBar = CommandBars.Add(Name:="Custom1", Position:=msoBarPopup, Temporary:=False)

    With myBar
        
        Set combo = .Controls.Add(msoControlButton)
        combo.Caption = "Button 1"
              
        Set combo = .Controls.Add(msoControlButton)
        combo.Caption = "Button 2"
        
        Set combo = .Controls.Add(msoControlButton)
        combo.Caption = "Button 3"
        
        Set combo = .Controls.Add(msoControlComboBox)
        With combo
            .Caption = "Circular references containing node:"
            .Tag = "Circular References"
            .DropDownWidth = 70
            .AddItem "Any node", 1
            .AddItem "Node 1", 2
            .AddItem "Node 2", 3
            .ListIndex = 0
        End With

    Set combo = Nothing
    Set myBar = Nothing
    End With

Select allOpen in new window

VT,

I don't remember what the other parameters are for the control.add method, but you might want to try it with:

Set Combo = cbr.Controls.Add(msoControlComboBox, , , , True)

That would set Temporary = True.  I saw that in your code and tried that as well with no success.  Has this element been completely removed from Access 2007?

VT,

The following worked for me.

Public Sub TestBar()

    Dim myBar As Office.CommandBar
    Dim combo As Office.CommandBarControl
    Set myBar = CommandBars.Add(Name:="Custom1", Position:=msoBarPopup, Temporary:=False)

    With myBar
        
        Set combo = .Controls.Add(msoControlButton)
        With combo
            .Caption = "Button 1"
        End With
              
        Set combo = .Controls.Add(msoControlButton)
        With combo
            .Caption = "Button 2"
        End With
        
        Set combo = .Controls.Add(msoControlButton)
        With combo
            .Caption = "Button 3"
        End With
        
        Set combo = .Controls.Add(msoControlComboBox, , , , True)
        With combo
            .Caption = "Circular references containing node:"
            .Tag = "Circular References"
            .DropDownWidth = 70
            .AddItem "Any node", 1
            .AddItem "Node 1", 2
            .AddItem "Node 2", 3
            .ListIndex = 0
        End With

        Set combo = Nothing
    Set myBar = Nothing
    End With

End Sub

Select allOpen in new window

Still nothing for me... I copied exactly... Do I need to include a reference to something?

Are you using 2007 or 2003?

2007.

I've got the following references in my test file:

VB for Apps
MS Access 12.0 Obj Lib
OLE Automation
MS 12.0 Access database enging
MS 12.0 Object Library

I noticed that when you instantiated "Custom1" you set Temporary = False.
Try deleting the commandbar: commandbars("Custom1").Delete
Then rerun the TestBar code and call the popup

Call TestBar
commandbars("Custom1").showpopup

When I run

commandbars("Custom1").showpopup

it works fine.  There must be something in the form that does not allow comboboxes in shortcut menus.  

In my forms property I have ShortcutMenu set to "Custom1" and when I right click on that it doesn't show the combobox.

OK!!!!!!!!!

So if I use CommandBars("custom1").ShowPopup it works perfectly, but if I use the Shortcutmenu property of the form, then I cannot see the combo box, but I can set sub menus.

There are 3 basic CommandBar Objects, msoControlButton, msoControlComboBox, msoControlPopUp

The msoControlPopUp has the property of .Controls allowing you to add controls to the pop up.

See this code below to create a pop up menu

 

Public Sub TestBar()

    Dim myBar As Office.CommandBar
    Dim combo As Office.CommandBarControl
    Dim SubControl As Office.CommandBarControl
    Set myBar = CommandBars.Add(Name:="Custom1", Position:=msoBarPopup, Temporary:=False)

    With myBar
        
        Set combo = .Controls.Add(msoControlButton)
        With combo
            .Caption = "Button 1"
        End With
              
        Set combo = .Controls.Add(msoControlButton)
        With combo
            .Caption = "Button 2"
        End With
        
        Set combo = .Controls.Add(msoControlButton)
        With combo
            .Caption = "Button 3"
        End With
        
        Set combo = .Controls.Add(msoControlDropdown)
        With combo
            .Caption = "Circular references containing node:"
            .Tag = "Circular References"
            .DropDownWidth = 70
            .AddItem "Any node", 1
            .AddItem "Node 1", 2
            .AddItem "Node 2", 3
            .ListIndex = 0
        End With
        
        Set combo = .Controls.Add(msoControlPopup)
        With combo
            .Caption = "Sub Menu"
            Set SubControl = .Controls.Add(msoControlButton)
            With SubControl
                .Caption = "SubButton1"
            End With
            
            Set SubControl = .Controls.Add(msoControlButton)
            With SubControl
                .Caption = "SubButton2"
            End With
        End With

    Set combo = Nothing
    Set SubControl = Nothing
    Set myBar = Nothing
    End With

End Sub

Select allOpen in new window

This is the end result

 
I might take it upon myself to write a 3rd party app that creates these menus for you since Microsoft took it out.

I feel like I really understand them now.

Thanks for going through this with me.

Glad I could help.

Looks like you need to write an article on the topic.  If you don't want to do this, maybe I will.

I will probably write an article on this sometime after the holdiays.  I will be slammed at work until then and you know how the weekends are during this time, always running around.

Thanks again for your help... I might be able to use your assistance when writing the article.

Would enjoy collaborating with you on the the article.

I tried using the commandbar as the source for the forms ShortCutMenu, turned that back on, and confirmed that the combo did not display, although the submenu (popup) does.  I may send a note to some of the Access MVPs to see if they have the same problem with Access 2007, and if so, will try to send the MS Access development team a note with the "bug".

Seems if .. you have the option, I would move to A2010.  Not that it eliminates this issue, but ... A2007 is now Four.Five years old!

mx

True,

But some people still use Access 2003!!! so until Everyone moves to 2010, I think 2007 is safer.  I just know I would like a new feature of 2010.  Try to incorporate it, and then I am instantly no longer compatible with 2007 or 2003.

Our company gradually moves to the new versions.  All new employees get Windows 7 and 2010, but existing employees stay on XP and 2007 until it is time for their laptop to be upgraded.  Then they will get the new goods.

"But some people still use Access 2003!!! '
Some? Actually most ...
O2010 deployment at my company (HUGE) starts this month across the enterprise!

mx

Good luck with that.

We have about 3500 employees here, and I don't think we wanted to tackle a company wide deployment.  

"We have about 3500 employees"
We have 1500 peeps in the IT Dept alone :-)

They broke pattern and skipped O2007 completely. It will take several months to complete. My apps will remain in MDB format, but will need to run in both environments.  I'm testing now ...

mx

Wow... you weren't kidding (HUGE) may have been an understatement.

I'm new to this whole scene.  I've only been working in Access for just over a year.  And I am not an IT guy.

I started using EE because every google search I typed in led me here, so I just started paying for the subscription, now I am answering some questions, so I'm considered a qualified expert, but by no means am I a true expert.  I like the challenge though.  I see you and fyed on all these other questions to. It seems like a pretty solid community and I'm looking forward to contributing and learning more.

"And I am not an IT guy."
That's a relief, lol.  IT peeps HATE Access.  I'm pretty much under the radar at work with Access in our Dept.  But if IT peeps saw that apps I've done and the *fact* that several are support upwards of 50-60 simultaneous users over a WAN ... they would faint.  They would be in disbelief !! Fortunately, the provide us with a STELLAR super high speed network

Yes, all searches seem to lead to EE .. even to question just posted !!!!!! Nice to have you around.

mx