Lawrence
07-01-2008, 01:33 PM
I found this excellent code to create a navigation menu. The only problem is that is shows all the tabs, including the hidden ones. Can someone help me modify it to only show the visible tabs?
Thank you.
Option Private Module 'prevent menu macros appearing under Tools|Macros
Sub CreateMenu()
Dim MenuObject As CommandBarPopup, MenuItem As Object
Dim SubMenuItem As CommandBarButton, Sh As Worksheet, i As Long
' Make sure the menus aren't duplicated
Call DeleteMenu
' Add the top-level menu to the Worksheet CommandBar
Set MenuObject = Application.CommandBars(1). _
Controls.Add(Type:=msoControlPopup, Temporary:=True)
'Name of top level menu. Remember to also change caption in DeleteMenu macro
MenuObject.Caption = "&Navigate"
'Add 1st menu item
Set MenuItem = MenuObject.Controls.Add(Type:=msoControlPopup)
MenuItem.Caption = "Go To Sheet"
'Add sub menu items to 1st menu
For Each Sh In ThisWorkbook.Sheets
i = i + 1
Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton)
SubMenuItem.Caption = Sh.Name
SubMenuItem.OnAction = "'LinkSheet(" & i & ")'"
If ActiveSheet.Name = Sh.Name Then SubMenuItem.FaceId = 1087
Next Sh
End Sub
Sub LinkSheet(ShtName As Integer)
If IsMissing(ShtName) Then Exit Sub
On Error Resume Next
Sheets(ShtName).Select
Range("A1").Select
On Error GoTo 0
End Sub
Sub DeleteMenu()
' This sub should be executed when the workbook is closed
' Deletes the Menus
On Error Resume Next
'Change &My Menu to the menu name you want
Application.CommandBars(1).Controls("&Navigate").Delete
On Error GoTo 0
End Sub
Thank you.
Option Private Module 'prevent menu macros appearing under Tools|Macros
Sub CreateMenu()
Dim MenuObject As CommandBarPopup, MenuItem As Object
Dim SubMenuItem As CommandBarButton, Sh As Worksheet, i As Long
' Make sure the menus aren't duplicated
Call DeleteMenu
' Add the top-level menu to the Worksheet CommandBar
Set MenuObject = Application.CommandBars(1). _
Controls.Add(Type:=msoControlPopup, Temporary:=True)
'Name of top level menu. Remember to also change caption in DeleteMenu macro
MenuObject.Caption = "&Navigate"
'Add 1st menu item
Set MenuItem = MenuObject.Controls.Add(Type:=msoControlPopup)
MenuItem.Caption = "Go To Sheet"
'Add sub menu items to 1st menu
For Each Sh In ThisWorkbook.Sheets
i = i + 1
Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton)
SubMenuItem.Caption = Sh.Name
SubMenuItem.OnAction = "'LinkSheet(" & i & ")'"
If ActiveSheet.Name = Sh.Name Then SubMenuItem.FaceId = 1087
Next Sh
End Sub
Sub LinkSheet(ShtName As Integer)
If IsMissing(ShtName) Then Exit Sub
On Error Resume Next
Sheets(ShtName).Select
Range("A1").Select
On Error GoTo 0
End Sub
Sub DeleteMenu()
' This sub should be executed when the workbook is closed
' Deletes the Menus
On Error Resume Next
'Change &My Menu to the menu name you want
Application.CommandBars(1).Controls("&Navigate").Delete
On Error GoTo 0
End Sub