problem with custom menu

[Guest]

I had to modify my custom menu. Originally adding and removing my custom
menus was done by the following code:

-------------------------------------------------
Set cmbMenu = CommandBars("Worksheet Menu Bar"). _
Controls.Add(Type:=msoControlPopup, _
Before:=CommandBars("Worksheet Menu Bar") _
.Controls.Count)
' Set the caption of the new menu.
With cmbMenu
.Caption = "My Macros"
.DescriptionText = "Macros Menu"
End With
----------------------------------------------------------
Sub RemoveMenus()
On Error Resume Next
' Remove Menu Bar.
CommandBars("Worksheet Menu Bar").Controls("My Macros").Delete
End Sub
----------------------------------------------------------


Because I have to use special characters in the names of my custom menu,
following the advice from this group I modified my code to:

----------------------------------------------------------
Set cmbMenu = CommandBars("Worksheet Menu Bar"). _
Controls.Add(Type:=msoControlPopup, _
Before:=CommandBars("Worksheet Menu Bar") _
.Controls.Count)
' Set the caption of the new menu.
With cmbMenu
.Caption = Range("menu1")
.DescriptionText = "Macros Menu"
End With
----------------------------------------------------------

Now executing of the code is replacing before last menu item with my menu.
What I am doing wrong ? How I have to modify my code so that my menu will add
new menu, not replace one of the existing ones. How I need to modify the
removing code so that my new menu will be removed when closing the workbook.

Thanks for advice.

Regards,

Tony

 

[keepITcool]

Tony



assuming your still prepping for multilanguage
you could do all kings of lookup stuff but for now..

Create and name a range with the captions
Create and name a range with the tooltips

example assumes the 2nd column(language) will be read from the ranges.


Use a TAG for easy identification of your controls
Use TEMPORARY to prevent contamination of the olb cache.
Use qualified referencing to read your ranges.

Use a language variable to pick the correct language form your ranges..

I've used with/end syntax for simplicity of my example
but you can use variables for the bar and the controls.


Option Explicit

Const cTAG = "TonyStuff"
Sub MakeMenu()
Dim iLanguageCol

iLanguageCol = 2

With Application.CommandBars(1)
On Error Resume Next
.FindControl(Tag:=cTAG, recursive:=True).Delete
On Error GoTo 0
With .Controls.Add(Type:=msoControlPopup, _
Before:=.Controls.Count, temporary:=True)
.Tag = cTAG
.Caption = ThisWorkbook.Worksheets(1).Range( _
"Captions").Cells(1, iLanguageCol)
.TooltipText = ThisWorkbook.Worksheets(1).Range( _
"Tooltips").Cells(1, iLanguageCol)
With .Controls.Add(temporary:=True)
.Tag = cTAG
.Caption = ThisWorkbook.Worksheets(1).Range( _
"Captions").Cells(2, iLanguageCol)
.TooltipText = ThisWorkbook.Worksheets(1).Range( _
"Tooltips").Cells(2, iLanguageCol)
End With
End With
End With

End Sub






--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Tony wrote :

 

[Guest]

I have found the source of my problem. In the code I was checking if the menu
already existed to make sure it will not be multiplied. My problem is now how
to find out if the menu which caption is setup by:

..Caption = Range("menu1")

already exist.

After checking it will be added or not as required. The second question is
how to modify the menu deleting code.

Thanks for help.

Tony

..

 

[Bob Phillips]

No need to bother, just delete it with error handling, and then add it.

Sub RemoveMenuControl(cb As CommandBar, ctl As String)
On Error Resume Next
' Remove Menu Control
cb.Controls(ctl).Delete
On Error GoTo 0
End Sub


Sub addMenu()
Dim cb As CommandBar
Dim cmbmenu As CommandBarControl

Set cb = CommandBars("Worksheet Menu Bar")
RemoveMenuControl cb, "Menu1"
Set cmbmenu = cb.Controls.Add(Type:=msoControlPopup, _
Before:=CommandBars("Worksheet Menu Bar") _
.Controls.Count)
' Set the caption of the new menu.
With cmbmenu
.Caption = "menu1" 'Range("menu1")
.DescriptionText = "Macros Menu"
End With

End Sub

 

[Guest]

Thank you for all your help. I have all my problems solved, all is working
just as intended.

Regards,

Tony