Adding custom menus to Excel ????

  • Thread starter Thread starter JoeJoe
  • Start date Start date
J

JoeJoe

Hello all - Ive been pulling my hair out trying to add customer menus
to Excel. I have been able to add a menu between "Window" and "Help"
named "ADS Reports". In addition, I have added several sub-menus with
this hierarchy:

ADS Reports
- ADS Total
- View
- Full Detail
- MTD

However, I am trying to program this type of hierarchy:

ADS Reports
- ADS Total
- View
- Full Detail
- MTD
- Dec Total
- View
- Full Detail
- MTD
- Analytics Total
- View
- Full Detail
- MTD
- Etc.....

Here is what I have been working with

Sub AddMenus()
Dim cMenu1 As CommandBarControl
Dim cbMainMenuBar As CommandBar
Dim iHelpMenu As Integer
Dim cbcCutomMenu As CommandBarControl

'(1)Delete any existing one. We must use On Error Resume next _
in case it does not exist.
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls("&ADS
Reports").Delete
On Error GoTo 0

'(2)Set a CommandBar variable to Worksheet menu bar
Set cbMainMenuBar = _
Application.CommandBars("Worksheet Menu Bar")

'(3)Return the Index number of the Help menu. We can then use _
this to place a custom menu before.
iHelpMenu = _
cbMainMenuBar.Controls("Help").Index

'(4)Add a Control to the "Worksheet Menu Bar" before Help.
'Set a CommandBarControl variable to it
Set cbcCutomMenu = _
cbMainMenuBar.Controls.Add(Type:=msoControlPopup, _
Before:=iHelpMenu)

'(5)Give the control a caption
cbcCutomMenu.Caption = "&ADS Reports"

'Add another menu that will lead off to another menu
'Set a CommandBarControl variable to it
Set cbcCutomMenu = cbcCutomMenu.Controls.Add(Type:=msoControlPopup)
' Give the control a caption
cbcCutomMenu.Caption = "ADS Total"

'Add another menu that will lead off to another menu
'Set a CommandBarControl variable to it
Set cbcCutomMenu = cbcCutomMenu.Controls.Add(Type:=msoControlPopup)
' Give the control a caption
cbcCutomMenu.Caption = "View"

'(6)Working with our new Control, add a sub control and _
give it a Caption and tell it which macro to run (OnAction).
With cbcCutomMenu.Controls.Add(Type:=msoControlButton)
.Caption = "Full Detail"
.OnAction = "MyMacro1"
End With
'(6a)Add another sub control give it a Caption _
and tell it which macro to run (OnAction)
With cbcCutomMenu.Controls.Add(Type:=msoControlButton)
.Caption = "MTD-YTD-FY"
.OnAction = "MyMacro2"
End With


End Sub

Any suggestion for what I can add to my current programming or even
starting from scratch?
 
Sub AddMenus()
Dim cMenu1 As CommandBarControl
Dim cbMainMenuBar As CommandBar
Dim iHelpMenu As Integer
Dim cbcCutomMenu As CommandBarControl

'(1)Delete any existing one. We must use On Error Resume next _
in case it does not exist.
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar") _
.Controls("&ADS Reports").Delete
On Error GoTo 0

Set cbMainMenuBar = _
Application.CommandBars("Worksheet Menu Bar")

iHelpMenu = cbMainMenuBar.Controls("Help").Index

With cbMainMenuBar.Controls.Add(Type:=msoControlPopup, _
Before:=iHelpMenu)
.Caption = "&ADS Reports"

With .Controls.Add(Type:=msoControlPopup)
.Caption = "ADS Total"

With .Controls.Add(Type:=msoControlPopup)
.Caption = "View"

With .Controls.Add(Type:=msoControlButton)
.Caption = "Full Detail"
.OnAction = "MyMacro1"
End With

With .Controls.Add(Type:=msoControlButton)
.Caption = "MTD-YTD-FY"
.OnAction = "MyMacro2"
End With

End With

End With

With .Controls.Add(Type:=msoControlPopup)
.Caption = "Dec Total"

With .Controls.Add(Type:=msoControlPopup)
.Caption = "View"

With .Controls.Add(Type:=msoControlButton)
.Caption = "Full Detail"
.OnAction = "MyMacro1"
End With

With .Controls.Add(Type:=msoControlButton)
.Caption = "MTD-YTD-FY"
.OnAction = "MyMacro2"
End With

End With

End With

'etc.

End With


End Sub


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
 
Thank you - just what I needed.
Bob said:
Sub AddMenus()
Dim cMenu1 As CommandBarControl
Dim cbMainMenuBar As CommandBar
Dim iHelpMenu As Integer
Dim cbcCutomMenu As CommandBarControl

'(1)Delete any existing one. We must use On Error Resume next _
in case it does not exist.
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar") _
.Controls("&ADS Reports").Delete
On Error GoTo 0

Set cbMainMenuBar = _
Application.CommandBars("Worksheet Menu Bar")

iHelpMenu = cbMainMenuBar.Controls("Help").Index

With cbMainMenuBar.Controls.Add(Type:=msoControlPopup, _
Before:=iHelpMenu)
.Caption = "&ADS Reports"

With .Controls.Add(Type:=msoControlPopup)
.Caption = "ADS Total"

With .Controls.Add(Type:=msoControlPopup)
.Caption = "View"

With .Controls.Add(Type:=msoControlButton)
.Caption = "Full Detail"
.OnAction = "MyMacro1"
End With

With .Controls.Add(Type:=msoControlButton)
.Caption = "MTD-YTD-FY"
.OnAction = "MyMacro2"
End With

End With

End With

With .Controls.Add(Type:=msoControlPopup)
.Caption = "Dec Total"

With .Controls.Add(Type:=msoControlPopup)
.Caption = "View"

With .Controls.Add(Type:=msoControlButton)
.Caption = "Full Detail"
.OnAction = "MyMacro1"
End With

With .Controls.Add(Type:=msoControlButton)
.Caption = "MTD-YTD-FY"
.OnAction = "MyMacro2"
End With

End With

End With

'etc.

End With


End Sub


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
Click to expand...
 
Back
Top