Programmatically create pop up menu

[Paul]

Hi,

I am trying to programmatically create a pop up menu. (My users are
selecting an item from a combo, but they say the list of options is now too
long for them and want to break them into categories,. They would like the
list to appear 'like a Windows menu with submenus' and I am trying to create
a demo to see if this is feasible).

I have copied the following code off the web to get started with (works fine
once you add a reference Microsoft Office X Object Library). The problem I
am having is that when I change the msoBarTop constant to msoPopUp on the
following line:

Set cmdNewMenu = Application.CommandBars.Add(strMenuName, msoBarTop, True,
False)

the code fails on this line with an invalid procedure call or argument
(Access 2003 - I am yet to test in other versions). Also I don't seem to be
able to change the type of an existing bar to msoPopUp as Type is a read
only property.

Any thoughts as to what is wrong or how I resolve this?

Thanks

Paul


Public Function CreateTestBar()
Dim i As Integer
Dim x As Integer
Dim y As Integer
Dim strMenuName As String
Dim cmdNewMenu As CommandBar
Dim cctlSubMenu As CommandBarControl
Dim CBarCtl As CommandBarControl

'i the popmenus
'x is the buttons
x = 1
i = 1
y = 1


strMenuName = "ButtonTest40833" 'Make sure you don't have a button named
"ButtonTest40833", this function would delete it.
If fIsCreated(strMenuName) Then
Application.CommandBars(strMenuName).Delete
End If

Set cmdNewMenu = Application.CommandBars.Add(strMenuName, msoBarTop,
True, False)
For i = 1 To 100
Set cctlSubMenu = cmdNewMenu.Controls.Add(Type:=10)

cctlSubMenu.Caption = i
cctlSubMenu.BeginGroup = True

y = x + 50
For x = x To (y)
Set CBarCtl = cctlSubMenu.Controls.Add(Type:=msoControlButton)
With CBarCtl
.Caption = Chr(34) & x & Chr(34)
.FaceId = x
End With
Next
Next
cmdNewMenu.Visible = True

End Function

Function fIsCreated(strMenuName) As Boolean

Dim intNumberMenus As Integer
Dim i As Integer

intNumberMenus = Application.CommandBars.Count

fIsCreated = False

For i = 1 To intNumberMenus
If Application.CommandBars(i).Name = strMenuName Then
fIsCreated = True
i = intNumberMenus
End If
Next

End Function

 

[Paul]

OK - I found a workaround...

Just create an empty Shortcut menu first and just clear/repopulate that as
needed ! I can keep re-using the same menu, so creating new shortcut menus
is not required in this case.

Thanks anyway.