Custom file menu used to redirect to desired sheet
 

I want to create a file menu that contains a submenu that lists all sheets in
the workbook and when a sheet is selected it is subsequently activated.

I've created the list and alphabetized it.
I've also created all menus. Current the path is Look At Me List of
Sheets (all sheets listed).

what I need to have happen is when a sheet name is selected it then needs to
be activated. I can't seem to figure out how to capture which sheet was
selected from the menu list.

See my code below. CreateMenu and RemoveMenu are called from the
workbook_activate and _deactivate events. The JumpToSheet macro would be
where I would handle the activation of the selected sheet.

Thanks-
JNW

Sub CreateMenu()
Dim HelpIndex As Integer
Dim NewMenu As CommandBarPopup
Dim sh As Worksheet

''make list of sheets
Sheets("Sheet1").Range(Range("A2"), Range("A2").End(xlDown)).ClearContents
For Each sh In Worksheets
Sheets("Sheet1").Range("A65536").End(xlUp).Offset( 1, 0).Value =
sh.Name
Next sh
HelpIndex = CommandBars(1).Controls("Help").Index

Set NewMenu = CommandBars(1).Controls.Add(Type:=msoControlPopup, _
Befo=HelpIndex, Temporary:=True)
NewMenu.Caption = "&Look at me"

''sub menu - Jump to Sheet...
Set Item = CommandBars(1).Controls("Look at
me").Controls.Add(Type:=msoControlPopup)
Item.Caption = "Jump to sheet..."

''Sub of Jump to Sheet
For Each cell In Range(Range("A2"), Range("A2").End(xlDown))
'Set Item = CommandBars(1).Controls("Look at me").Controls("Jump to
sheet...").Controls.Add
With Item.Controls.Add(Type:=msoControlButton)
If cell < "" Then
.Caption = cell.Value
.OnAction = "JumpToSheet"
End If
End With
Next cell
End Sub

Sub RemoveMenu()
On Error Resume Next
Application.CommandBars(1).Controls("Look at me").Delete
Application.CommandBars(2).Controls("look at me").Delete
End Sub

Sub JumpToSheet(SheetName)
Sheets(SheetName).Activate
End Sub

Custom file menu used to redirect to desired sheet
 

Found my answer from:
http://msdn.microsoft.com/newsgroups...e-34d5cda35350

Quote:
"double quote and simple quote and Sub Name and 3 x double quote & Parameter
& 3 x double quote and simple quote and double quote
Example: .OnAction = "'MySub """ & Parameter & """'"
Regards,
MP"


"JNW" wrote:

I want to create a file menu that contains a submenu that lists all sheets in
the workbook and when a sheet is selected it is subsequently activated.

I've created the list and alphabetized it.
I've also created all menus. Current the path is Look At Me List of
Sheets (all sheets listed).

what I need to have happen is when a sheet name is selected it then needs to
be activated. I can't seem to figure out how to capture which sheet was
selected from the menu list.

See my code below. CreateMenu and RemoveMenu are called from the
workbook_activate and _deactivate events. The JumpToSheet macro would be
where I would handle the activation of the selected sheet.

Thanks-
JNW

Sub CreateMenu()
Dim HelpIndex As Integer
Dim NewMenu As CommandBarPopup
Dim sh As Worksheet

''make list of sheets
Sheets("Sheet1").Range(Range("A2"), Range("A2").End(xlDown)).ClearContents
For Each sh In Worksheets
Sheets("Sheet1").Range("A65536").End(xlUp).Offset( 1, 0).Value =
sh.Name
Next sh
HelpIndex = CommandBars(1).Controls("Help").Index

Set NewMenu = CommandBars(1).Controls.Add(Type:=msoControlPopup, _
Befo=HelpIndex, Temporary:=True)
NewMenu.Caption = "&Look at me"

''sub menu - Jump to Sheet...
Set Item = CommandBars(1).Controls("Look at
me").Controls.Add(Type:=msoControlPopup)
Item.Caption = "Jump to sheet..."

''Sub of Jump to Sheet
For Each cell In Range(Range("A2"), Range("A2").End(xlDown))
'Set Item = CommandBars(1).Controls("Look at me").Controls("Jump to
sheet...").Controls.Add
With Item.Controls.Add(Type:=msoControlButton)
If cell < "" Then
.Caption = cell.Value
.OnAction = "JumpToSheet"
End If
End With
Next cell
End Sub

Sub RemoveMenu()
On Error Resume Next
Application.CommandBars(1).Controls("Look at me").Delete
Application.CommandBars(2).Controls("look at me").Delete
End Sub

Sub JumpToSheet(SheetName)
Sheets(SheetName).Activate
End Sub