Hi,
I am using the menumakr.exe tool that I downloaded from http://www.j-walk.com/ss/excel/tips/tip53.htm
The tool works great. The only problem is that when I switch to a chart sheet in my workbook, my custom menu disappears.
Can someone please tell me how to modify the following code so that my custom menu appears in all of my chart sheets as well?
Many thanks for any help.
________________________________
Option Explicit
Sub CreateMenu()
' This sub should be executed when the workbook is opened.
' NOTE: There is no error handling in this subroutine
Dim MenuSheet As Worksheet
Dim MenuObject As CommandBarPopup
Dim MenuItem As Object
Dim SubMenuItem As CommandBarButton
Dim Row As Integer
Dim MenuLevel, NextLevel, PositionOrMacro, Caption, Divider, FaceId
''''''''''''''''''''''''''''''''''''''''''''''''''''
' Location for menu data
Set MenuSheet = ThisWorkbook.Sheets("MenuSheet")
''''''''''''''''''''''''''''''''''''''''''''''''''''
' Make sure the menus aren't duplicated
Call DeleteMenu
' Initialize the row counter
Row = 2
' Add the menus, menu items and submenu items using
' data stored on MenuSheet
Do Until IsEmpty(MenuSheet.Cells(Row, 1))
With MenuSheet
MenuLevel = .Cells(Row, 1)
Caption = .Cells(Row, 2)
PositionOrMacro = .Cells(Row, 3)
Divider = .Cells(Row, 4)
FaceId = .Cells(Row, 5)
NextLevel = .Cells(Row + 1, 1)
End With
Select Case MenuLevel
Case 1 ' A Menu
' Add the top-level menu to the Worksheet CommandBar
Set MenuObject = Application.CommandBars(1). _
Controls.Add(Type:=msoControlPopup, _
Before:=PositionOrMacro, _
Temporary:=True)
MenuObject.Caption = Caption
Case 2 ' A Menu Item
If NextLevel = 3 Then
Set MenuItem = MenuObject.Controls.Add(Type:=msoControlPopup)
Else
Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
MenuItem.OnAction = PositionOrMacro
End If
MenuItem.Caption = Caption
If FaceId <> "" Then MenuItem.FaceId = FaceId
If Divider Then MenuItem.BeginGroup = True
Case 3 ' A SubMenu Item
Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton)
SubMenuItem.Caption = Caption
SubMenuItem.OnAction = PositionOrMacro
If FaceId <> "" Then SubMenuItem.FaceId = FaceId
If Divider Then SubMenuItem.BeginGroup = True
End Select
Row = Row + 1
Loop
End Sub
Sub DeleteMenu()
' This sub should be executed when the workbook is closed
' Deletes the Menus
Dim MenuSheet As Worksheet
Dim Row As Integer
Dim Caption As String
On Error Resume Next
Set MenuSheet = ThisWorkbook.Sheets("MenuSheet")
Row = 2
Do Until IsEmpty(MenuSheet.Cells(Row, 1))
If MenuSheet.Cells(Row, 1) = 1 Then
Caption = MenuSheet.Cells(Row, 2)
Application.CommandBars(1).Controls(Caption).Delete
End If
Row = Row + 1
Loop
On Error GoTo 0
End Sub
I am using the menumakr.exe tool that I downloaded from http://www.j-walk.com/ss/excel/tips/tip53.htm
The tool works great. The only problem is that when I switch to a chart sheet in my workbook, my custom menu disappears.
Can someone please tell me how to modify the following code so that my custom menu appears in all of my chart sheets as well?
Many thanks for any help.
________________________________
Option Explicit
Sub CreateMenu()
' This sub should be executed when the workbook is opened.
' NOTE: There is no error handling in this subroutine
Dim MenuSheet As Worksheet
Dim MenuObject As CommandBarPopup
Dim MenuItem As Object
Dim SubMenuItem As CommandBarButton
Dim Row As Integer
Dim MenuLevel, NextLevel, PositionOrMacro, Caption, Divider, FaceId
''''''''''''''''''''''''''''''''''''''''''''''''''''
' Location for menu data
Set MenuSheet = ThisWorkbook.Sheets("MenuSheet")
''''''''''''''''''''''''''''''''''''''''''''''''''''
' Make sure the menus aren't duplicated
Call DeleteMenu
' Initialize the row counter
Row = 2
' Add the menus, menu items and submenu items using
' data stored on MenuSheet
Do Until IsEmpty(MenuSheet.Cells(Row, 1))
With MenuSheet
MenuLevel = .Cells(Row, 1)
Caption = .Cells(Row, 2)
PositionOrMacro = .Cells(Row, 3)
Divider = .Cells(Row, 4)
FaceId = .Cells(Row, 5)
NextLevel = .Cells(Row + 1, 1)
End With
Select Case MenuLevel
Case 1 ' A Menu
' Add the top-level menu to the Worksheet CommandBar
Set MenuObject = Application.CommandBars(1). _
Controls.Add(Type:=msoControlPopup, _
Before:=PositionOrMacro, _
Temporary:=True)
MenuObject.Caption = Caption
Case 2 ' A Menu Item
If NextLevel = 3 Then
Set MenuItem = MenuObject.Controls.Add(Type:=msoControlPopup)
Else
Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
MenuItem.OnAction = PositionOrMacro
End If
MenuItem.Caption = Caption
If FaceId <> "" Then MenuItem.FaceId = FaceId
If Divider Then MenuItem.BeginGroup = True
Case 3 ' A SubMenu Item
Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton)
SubMenuItem.Caption = Caption
SubMenuItem.OnAction = PositionOrMacro
If FaceId <> "" Then SubMenuItem.FaceId = FaceId
If Divider Then SubMenuItem.BeginGroup = True
End Select
Row = Row + 1
Loop
End Sub
Sub DeleteMenu()
' This sub should be executed when the workbook is closed
' Deletes the Menus
Dim MenuSheet As Worksheet
Dim Row As Integer
Dim Caption As String
On Error Resume Next
Set MenuSheet = ThisWorkbook.Sheets("MenuSheet")
Row = 2
Do Until IsEmpty(MenuSheet.Cells(Row, 1))
If MenuSheet.Cells(Row, 1) = 1 Then
Caption = MenuSheet.Cells(Row, 2)
Application.CommandBars(1).Controls(Caption).Delete
End If
Row = Row + 1
Loop
On Error GoTo 0
End Sub