Popup menu problem

[Martin Stender]

HI all - I grabbed the commandbar code below from the help-examples in
PPT, but it keeps failing with two different error messages: some of
the time, the 'showPopup' function fails with "invalid procedure call
or argument'), and sometime the menu will show once, and the next time
it is being called, it fails.

Private Sub CommandButton1_MouseUp(ByVal Button As Integer, ByVal Shift
As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then
Set mybar = CommandBars.Add _
(Name:="Custom", Position:=msoBarPopup, Temporary:=False)
With mybar
.Controls.Add Type:=msoControlButton, Id:=3
.Controls.Add Type:=msoControlComboBox
End With
mybar.ShowPopup
End If
End Sub

Any ideas?

Best regards
Martin

 

[Martin Stender]

I forgot to add that it will be run from a form, not a slide ...

And I meant 'showPopup method', not function ... sorry

Martin

 

[Steve Rindsberg]

HI all - I grabbed the commandbar code below from the help-examples in
PPT, but it keeps failing with two different error messages: some of
the time, the 'showPopup' function fails with "invalid procedure call
or argument'), and sometime the menu will show once, and the next time
it is being called, it fails.

You can't add two commandbars with the same name, so the second time you try to
add it, it'll error.

Try this instead (warning: aircode!)

Private Sub CommandButton1_MouseUp(ByVal Button As Integer, ByVal Shift
As Integer, ByVal X As Single, ByVal Y As Single)
On Error GoTo ErrorHandler

If Button = 2 Then

' if it errors while adding toolbars and buttons
' just ignore it and keep going
On Error Resume Next

Set mybar = CommandBars.Add _
(Name:="Custom", Position:=msoBarPopup, Temporary:=False)
With mybar
.Controls.Add Type:=msoControlButton, Id:=3
.Controls.Add Type:=msoControlComboBox
End With

On Error GoTo ErrorHandler

' At this point, the command bar was either there in the first place
' or you've now created it so ... use it!
mybar.ShowPopup
End If
NormalExit:
Exit Sub
ErrorHandler:
' error handling code here if you like, else
Resume Next
End Sub

 

[Martin Stender]

Thank you Steve, you led me on the right track.

There were two problems:
1. my code would fail when trying to create a second commandbar with
the same name.
2. 'showpopup' requires that the main app is in focus.

This seems to work, although I do get an occasional error, but I think
that would never happen, when the code is run from an AddIn. (or?)

Private Sub CommandButton1_MouseUp(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

If Button = 2 Then 'right-click

Application.Activate 'make sure PPT has our attention

Set cmMenu = CommandBars
For i = 1 To cmMenu.Count
If cmMenu(i).Name = "myPopUp" Then
cmMenu(i).Delete
End If
Next i

Dim myPopUp As Object
Set myPopUp = Application.CommandBars. _
Add(Name:="myPopUp", Position:=msoBarPopup,
Temporary:=True)
With myPopUp
.Controls.Add Type:=msoControlButton, Id:=3
'add more buttons here
End With
myPopUp.ShowPopup
End If

End Sub

Best regards
Martin

 

[Martin Stender]

Aaargh ...

To the above code, I've added one more button using this:

Set NewControl = .Controls.Add(Type:=msoControlButton)
With NewControl
.FaceId = 10
.Caption = "testing menu item"
.OnAction = "doStuff"
End With

There's of course a doStuff() function further down in the code, but it
never gets a call from the above .OnAction property.

Am I more than ordinarily stupid or does this require some special
woodoo?

Best regards
Martin

 

[Steve Rindsberg]

Hi Martin,

I made a few modifications to your code and ended up with this, which seems to
work:

To start with, I create the popup in one routine but call it from another:

Sub CreateThePopup()

Dim cmMenu As CommandBars
Dim i As Long
Dim NewControl As CommandBarControl
Dim myPopup As CommandBar

Set cmMenu = Application.CommandBars
For i = 1 To cmMenu.Count
If cmMenu(i).Name = "myPopUp" Then
cmMenu(i).Delete
End If
Next i

Set myPopup = Application.CommandBars.Add(Name:="myPopUp", _
Position:=msoBarPopup)
With myPopup
.Controls.Add Type:=msoControlButton, Id:=3
'add more buttons here

Set NewControl = .Controls.Add(Type:=msoControlButton)
With NewControl
.FaceId = 10
.Caption = "testing menu item"
.OnAction = "doStuff"
End With

End With
' this errors here, but see below
'myPopup.ShowPopup

End Sub


Sub DisplayMyPopup()
' Call this to show the popup
Application.CommandBars("myPopUp").ShowPopup
End Sub

Sub doStuff()
' And this now works
' It may need to be a sub rather than a function - I didn't test that
' But you needed something to play with this weekend anyway, yes? ;-)
MsgBox "I did stuff"
End Sub

 

[Steve Rindsberg]

And a little more generic version here:

Add a popup toolbar
http://www.rdpslides.com/pptfaq/FAQ00768.htm

 

[Martin Stender]

Thank you Steve for taking the time.

I don't want to take up anymore of your time, but the doStuff sub still
don't get a call from the second menu item in the popup. I tried to
paste in the code from your site, and calling from a commandbutton like
this:

Private Sub CommandButton1_MouseUp(ByVal Button As Integer, ByVal Shift

As Integer, ByVal X As Single, ByVal Y As Single)
if Button = 2 then
CreateThePopup
DisplayMyPopup
end if
end sub

But never mind - I'll probably figure it out.
It's just weird it works in your end.

(I've also tried to make it into an add-in, just to try something, but
with the same result.)

Best regards
Martin

 

[Steve Rindsberg]

Thank you Steve for taking the time.

My pleasure, Martin.

One other thing to try:

Let your initialization code (for the form or app) create the popup and only
call DisplayMyPopup from click/mouseup routines.

You only need to create the popup once per session (assuming you change it back
to temporary status).

After that, you only need to ShowPopup to use it