Sub menu

[kalle]

Hi

How do I add a submenu to this?

Dim MyBar As CommandBar, MyItim As CommandBarControl
Set MyBar = CommandBars.Add(Name:="Sheet1menu", Position:=msoBarPopup,
Temporary:=True)


Set MyItim = MyBar.Controls.Add(Type:=msoControlButton)
With MyItim
.Caption = "Show"
.OnAction = "Macro1"
End With

Set MyItim = MyBar.Controls.Add(Type:=msoControlButton)
With MyItim
.Caption = "Show2"
.OnAction = "Macro2"
End With
This works fine but I want t ohave a submenu to the first one.

Thanks in advance

*** Sent via Developersdex http://www.developersdex.com ***

 

[Project Mangler]

Kalle,

I think you need to change the Type to msoControlpopup rather than
msoControlbutton and then add menus items under that.

This is a shortened version of one of mine:
Sub CreatePopup()
Dim cbpop As CommandBarControl
Dim cbsub As CommandBarControl
Dim cbc As CommandBarControl
Dim cbctl As CommandBarControl
Dim cbctl1 As CommandBarControl
Dim cbctl2 As CommandBarControl
Dim cbctl3 As CommandBarControl

'check if menu item exists: delete it if it does
Set cbc = Application.CommandBars( _
"Worksheet menu bar"). _
FindControl(Type:=msoControlPopup, _
Tag:="CustomMenuItem1")
If Not cbc Is Nothing Then cbc.Delete


' Create a popup control on the main menu bar
Set cbpop = Application.CommandBars("Worksheet Menu Bar"). _
Controls.Add(Type:=msoControlPopup, Temporary:=True)
cbpop.Caption = "Tes&T"
cbpop.Visible = True
cbpop.Tag = "CustomMenuItem1"

' Add a menu item
Set cbctl = cbpop.Controls.Add(Type:=msoControlButton)
cbctl.Visible = True
' Next is required for caption
cbctl.Style = msoButtonCaption
cbctl.Caption = "Men&u Item 1"
' Action to perform
cbctl.OnAction = "'" & ThisWorkbook.Name & "'!yourproc"

' Add a popup for a submenu item
Set cbctl1 = cbpop.Controls.Add(Type:=msoControlPopup)
cbctl1.Visible = True
' Next is required for caption
cbctl1.Caption = "Menu &Item 2"

' Add a first sub menu item
Set cbctl2 = cbctl1.Controls.Add(Type:=msoControlButton)
cbctl2.Visible = True
' Next is required for caption
cbctl2.Style = msoButtonCaption
cbctl2.Caption = "Sub&Menu Item 1"
' Action to perform
cbctl2.OnAction = "'" & ThisWorkbook.Name & "'!yourproc1"

' Add a second sub menu item
Set cbctl3 = cbctl1.Controls.Add(Type:=msoControlButton)
cbctl3.Visible = True
' Next is required for caption
cbctl3.Style = msoButtonCaption
cbctl3.Caption = "&Submenu Item 2"
' Action to perform
cbctl3.OnAction = "'" & ThisWorkbook.Name & "'!yourproc2"
End Sub

 

[Project Mangler]

OK I know know that you were setting up a shortcut menu - apologies for not
knowing that before:

Option Explicit
Sub popup()
Dim MyBar As CommandBar, MyItim1 As CommandBarControl, MyItim2 As
CommandBarControl
Dim MyItim3 As CommandBarControl, MyItim4 As CommandBarControl

Set MyBar = CommandBars.Add(Name:="Shtmenu", Position:=msoBarPopup,
Temporary:=True)


Set MyItim1 = MyBar.Controls.Add(Type:=msoControlButton)
With MyItim1
.Caption = "Show"
.OnAction = "Macro1"
End With

Set MyItim2 = MyBar.Controls.Add(Type:=msoControlPopup)
With MyItim2
.Caption = "Show2"
'.OnAction = "Macro2"
End With

Set MyItim3 = MyItim2.Controls.Add(Type:=msoControlButton)
With MyItim3
.Caption = "Show3"
.OnAction = "Macro3"
End With

Set MyItim4 = MyItim2.Controls.Add(Type:=msoControlButton)
With MyItim4
.Caption = "Show4"
.OnAction = "Macro4"
End With

MyBar.ShowPopup 200, 200
End Sub


Sub DelBars()
Dim bar As CommandBar
For Each bar In Application.CommandBars
If Not bar.BuiltIn Then bar.Delete
Next
End Sub

 

[kalle]

Yes, that was just what I needed.

Thanks a lot.

*** Sent via Developersdex http://www.developersdex.com ***