Create Menu with Call to Another Sub

[Rick]

Hi,

I'm trying to create an Excel menu with less code. The
sub calls another sub. My variables are simple, to make
it easy for this review. Eventually I was hoping to
change the two sets of variables to an array and loop
through that instead (maybe storing the menu data on a
hidden worksheet). But for now, I'm just looking at it in
a simple way.

I almost got it to work. The problem is that each of the
commandbar buttons are connected to two popups. How could
I better write this, using the structure provided (calling
the sub), so that the two commandbar buttons are connected
to only one popup?

I can do it the long way - I'm just looking for some
improvements, if at all possible. I don't know if it can
be done, but I thought I would run it by some of you.

Thanks, Rick

Sub CreateMenuCall()
DeleteMenu 'Call to delete previous menu

Dim a1 As String, d1 As String
Dim b1 As Integer, c1 As Boolean
Dim a2 As String, d2 As String
Dim b2 As Integer, c2 As Boolean
Dim M1 As CommandBarPopup

a1 = "Message No. &1"
b1 = 123
c1 = False
d1 = "Mess1"

a2 = "Message No. &2"
b2 = 123
c2 = False
d2 = "Mess1"

Set M1 = Application.CommandBars(1).Controls. _
Add(Type:=msoControlPopup, _
Before:=8, Temporary:=True)
M1.Caption = "Experiment"
DetailedMenu M1, a1, b1, c1, d1
DetailedMenu M1, a2, b2, c2, d2

End Sub

Sub DetailedMenu(M1 As CommandBarPopup, _
a As String, b As Integer, c As Boolean, d As String)

With M1.Controls.Add(Type:=msoControlPopup)
.Caption = "&Menu Choices"
With .Controls.Add(Type:=msoControlButton)
.Caption = a
.FaceId = b
.BeginGroup = c
.OnAction = d
End With
End With
End Sub

[Patrick Molloy]

On the worksheet, a row defines the menu, with
Col A button caption
Col B button face ID
Col C begin group (TRUE/FALSE)
Col D onaction name

each row would therefore represent one menu item. The
beauty is that you can very easily add, alter amd remove
menu items.
You need to modify your code, so in a standard module
paste this

Option Explicit

Dim M1 As CommandBarPopup

Sub CreateMenuCall()
DeleteMenu 'Call to delete previous menu

Dim MyMenus As Variant
Dim i As Long
MyMenus = Range(Range("A1"), _
Range("D100").End(xlUp))

Set M1 = Application.CommandBars(1).Controls. _
Add(Type:=msoControlPopup, _
Before:=8, Temporary:=True)

With M1
.Caption = "Experiment"

With M1.Controls.Add(Type:=msoControlPopup)
.Caption = "&Menu Choices"

For i = LBound(MyMenus, 1) To _
UBound(MyMenus, 1)
With .Controls.Add _
(Type:=msoControlButton)
.Caption = MyMenus(i, 1)
.FaceId = MyMenus(i, 2)
.BeginGroup = MyMenus(i, 3)
.OnAction = MyMenus(i, 4)
End With
Next i

End With
End With
End Sub

Sub DeleteMenu()
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls
("Experiment").Delete
End Sub

This should give you lots of ideas. Write to me directly
if anyone wants the file

Patrick Molloy
Microsoft Excel MVP

>.
>

[Rick]

Thanks Patrick,

I'll take a look at it. Thanks for taking some time with
this.

Rick

>> DetailedMenu MÍ{ wØ ù $^ÿ $¶ ¤"ö ìö 1, a2, b2, c2,

d2
>>
>>End Sub
>>
>>Sub DetailedMenu(M1 As CommandBarPopup, _
>>a As String, b As Integer, c As Boolean, d As String)
>>
>> With M1.Controls.Add(Type:=msoControlPopup)
>> .Caption = "&Menu Choices"
>> With .Controls.Add(Type:=msoControlButton)
>> .Caption = a
>> .FaceId = b
>> .BeginGroup = c
>> .OnAction = d
>> End With
>> End With
>>End Sub
>>.
>>

>.
>

[Rick]

Patrick,

Looking at the code you provided for me, gave me some
ideas. With that, I found a solution. It now works the
way that I wanted. Thanks so much!

I kept the variable and array names extremely simple for
testing purposes only. As you know, the data of each
array can be stored on a worksheet as well, so that the
users can change it, if they want. Thanks! Here's what I
did:

Sub CreateExperimentMenu()

DeleteMenu 'Call to delete previous menu

Dim M1 As CommandBarPopup

Set M1 = Application.CommandBars(1).Controls. _
Add(Type:=msoControlPopup, _
Before:=8, Temporary:=True)
M1.Caption = "Experiment"

DetailedMenuR1 M1
DetailedMenuR2 M1
End Sub

Sub DetailedMenuR1(M1 As CommandBarPopup)
Dim a(1 To 3) As String
Dim b(1 To 3) As Integer
Dim c(1 To 3) As Boolean
Dim d(1 To 3) As String
Dim i As Integer
a(1) = "Test1": b(1) = 2: c(1) = False: d(1) = ""
a(2) = "Test2": b(2) = 3: c(2) = False: d(2) = ""
a(3) = "Test3": b(3) = 4: c(3) = False: d(3) = ""
With M1.Controls.Add(Type:=msoControlPopup)
.Caption = "&First Choice"
.Enabled = True
For i = 1 To 3
With .Controls.Add(Type:=msoControlButton)
.Enabled = True
.Caption = a(i)
.FaceId = b(i)
.BeginGroup = c(i)
.OnAction = d(i)

End With
Next i
End With

End Sub

Sub DetailedMenuR2(M1 As CommandBarPopup)
Dim a(1 To 3) As String
Dim b(1 To 3) As Integer
Dim c(1 To 3) As Boolean
Dim d(1 To 3) As String
Dim i As Integer
a(1) = "Test1": b(1) = 2: c(1) = False: d(1) = ""
a(2) = "Test2": b(2) = 3: c(2) = False: d(2) = ""
a(3) = "Test3": b(3) = 4: c(3) = False: d(3) = ""
With M1.Controls.Add(Type:=msoControlPopup)
.Caption = "&Second Choice"
.Enabled = True
For i = 1 To 3
With .Controls.Add(Type:=msoControlButton)
.Enabled = True
.Caption = a(i)
.FaceId = b(i)
.BeginGroup = c(i)
.OnAction = d(i)

End With
Next i
End With

End Sub

Sub DeleteMenu()
On Error Resume Next

Application.CommandBars(1).Controls("Experiment").Delete
End Sub

>Í{ wÀ Ôn¯ |· ¤|! ìí