PDA

View Full Version : Navigation menu to only show visible tabs



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

xld
07-01-2008, 01:37 PM
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
If Sh.Visible = xlSheetVisible Then
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
End If
Next Sh
End Sub

Lawrence
07-01-2008, 01:41 PM
Outstanding, thank you very much.

Aussiebear
07-02-2008, 05:37 AM
Are you going to use this or the button event in your other thread?

Lawrence
07-02-2008, 08:10 AM
This is just a navigation menu that shows up at the top alongside the File, Edit, View, etc... menu. This is different than the other one.