Solved: Sub Menu in My Custom Menu

[jammer6_9]

Hi all, is it possible to create sub menu to pop up once I click with this Custom Menu. Once I click on "Range Analysis" menu I want to have a sub menu "Summary"...


Sub AddNewToolBar()
Dim ComBar As CommandBar, ComBarContrl As CommandBarControl
On Error GoTo ErrorHandler
On Error Resume Next
CommandBars("My Toolbar").Delete
Set ComBar = CommandBars.Add(Name:="OFS Analysis", Position:= _
msoBarFloating, Temporary:=True)
ComBar.Visible = True

With ComBar
.Top = 50
.Left = 650

Set ComBarContrl = ComBar.Controls.Add(Type:=msoControlButton)
With ComBarContrl
.Caption = "&Range Analysis"
.Style = msoButtonCaption
.TooltipText = "Flexible Analysis"
.OnAction = "Macro1"
End With

.Width = 150
.Visible = True


Exit Sub
ErrorHandler:
MsgBox "Error " & Err.Number & vbCr & Err.Description
Exit Sub
End With
End Sub

[jammer6_9]

:whistle: I found solution with xld sample menu editor to maryam...

[Zack Barresse]

Hi jammer6_9,

Great that you solved your own problem. Could you post what you used as your solution so that others may benefit from it as well? :)

[jammer6_9]

Not exactly as I planned but It works fine for me now thanks to "xld" codes. I would be grateful if you could give out upgrade of the code "sort of prefessional codes" not like mine "beginner" and most of them copied :rofl: ... Wherein If I can add "FaceId" with the SubMenus... :dunno how? xld :hi:

Sub AddNewToolBar()
Dim ComBar As CommandBar, ComBarContrl As CommandBarControl
On Error GoTo ErrorHandler
On Error Resume Next
CommandBars("My Toolbar").Delete
Set ComBar = CommandBars.Add(Name:="OFS Analysis", Position:= _
msoBarFloating, Temporary:=True)
ComBar.Visible = True

With ComBar
.Top = 50
.Left = 650

End With

Set ComBarContrl = ComBar.Controls.Add(Type:=msoControlPopup)
With ComBarContrl
.BeginGroup = True
.Caption = "&KSA"
.TooltipText = "Kingdom of Saudi Arabia"
.OnAction = "Macro1"
End With

Set ComBarContrl = ComBar.Controls.Add(Type:=msoControlPopup)
With ComBarContrl
.BeginGroup = True
.Caption = "&UAE"
.TooltipText = "United Arab Emirates"
.OnAction = "Macro2"
End With

Exit Sub
ErrorHandler:
MsgBox "Error " & Err.Number & vbCr & Err.Description
Exit Sub
End Sub

Sub KSA()
On Error Resume Next
Application.CommandBars("KSA").ShowPopup
CommandBars("KSA").Delete
On Error GoTo 0

With CommandBars.Add(Name:="KSA", Position:=msoBarPopup)
With .Controls.Add(Type:=msoControlButton)
.OnAction = "Macro9"
.Caption = "Analysis"
End With
With .Controls.Add(Type:=msoControlButton)
.OnAction = "Macro10"
.Caption = "Summary"
End With

With .Controls.Add(Type:=msoControlButton)
.OnAction = "Macro11"
.Caption = "Graph"
End With

With .Controls.Add(Type:=msoControlButton)
.OnAction = "Macro12"
.Caption = "Comments"
End With

End With
End Sub

Sub UAE()
On Error Resume Next
Application.CommandBars("UAE").ShowPopup
CommandBars("UAE").Delete
On Error GoTo 0

With CommandBars.Add(Name:="UAE", Position:=msoBarPopup)
With .Controls.Add(Type:=msoControlButton)
.OnAction = "Macro13"
.Caption = "Analysis"
End With

With .Controls.Add(Type:=msoControlButton)
.OnAction = "Macro14"
.Caption = "Summary"
End With

With .Controls.Add(Type:=msoControlButton)
.OnAction = "Macro15"
.Caption = "Graph"
End With

With .Controls.Add(Type:=msoControlButton)
.OnAction = "Macro16"
.Caption = "Summary"
End With

End With
End Sub

Sub macro1()
KSA
End Sub

Sub Macro2()
UAE
End Sub

Sub DeleteToolbar()
On Error Resume Next
CommandBars("OFS Analysis").Delete
End Sub




Hi jammer6_9,

Great that you solved your own problem. Could you post what you used as your solution so that others may benefit from it as well? :)

[Bob Phillips]

Sub KSA()
On Error Resume Next
Application.CommandBars("KSA").ShowPopup
CommandBars("KSA").Delete
On Error GoTo 0

With CommandBars.Add(Name:="KSA", Position:=msoBarPopup)
With .Controls.Add(Type:=msoControlButton)
.OnAction = "Macro9"
.Caption = "Analysis"
.Style = msoButtonIconAndCaption
.FaceId = 29
End With
With .Controls.Add(Type:=msoControlButton)
.OnAction = "Macro10"
.Caption = "Summary"
.Style = msoButtonIconAndCaption
.FaceId = 30
End With

With .Controls.Add(Type:=msoControlButton)
.OnAction = "Macro11"
.Caption = "Graph"
.Style = msoButtonIconAndCaption
.FaceId = 31
End With

With .Controls.Add(Type:=msoControlButton)
.OnAction = "Macro12"
.Caption = "Comments"
.Style = msoButtonIconAndCaption
.FaceId = 32
End With

End With
End Sub

[jammer6_9]

Solved. Solved. Solved... :bow: xld :bow: ... One more thing xld can I extend another menu to popup once the sub menu is click?

[Bob Phillips]

Like this



Sub KSA()
On Error Resume Next
Application.CommandBars("KSA").ShowPopup
CommandBars("KSA").Delete
On Error GoTo 0

With CommandBars.Add(Name:="KSA", Position:=msoBarPopup)
With .Controls.Add(Type:=msoControlButton)
.OnAction = "Macro9"
.Caption = "Analysis"
End With
With .Controls.Add(Type:=msoControlPopup)
.Caption = "Summary"
With .Controls.Add(Type:=msoControlButton)
.Caption = "Sub menu 1"
.OnAction = "Macro10"
End With
With .Controls.Add(Type:=msoControlButton)
.Caption = "Sub menu 2"
.OnAction = "Macro11"
End With
End With

With .Controls.Add(Type:=msoControlButton)
.OnAction = "Macro11"
.Caption = "Graph"
End With

With .Controls.Add(Type:=msoControlButton)
.OnAction = "Macro12"
.Caption = "Comments"
End With

End With
End Sub

[jammer6_9]

No more questions to ask with this thread xld... Thanks you really improve my understanding with this issue. I wont say thanks for now because for sure I'll be asking you more :super: ...