I have tried to establish a custom menu by borrowing the layout from J-Walk's Menumaker and using the following section of code
[VBA]
Sub CreateMenu()
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 sub menu 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 meu 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 SubMenuItem.FaceID = FaceID
If Divider Then SubMenuItem.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()
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
Sub DummyMacro()
MsgBox "This is a do nothing Macro."
End Sub
Sub About()
frmDetails.Show
End Sub
[/VBA]
The run time error message appears on opening the workbook, yet when I bring up the vbe environment and choose Debug/Compile project, there are no errors highlighted. What have I done wrong?
The menu sheet named Menusheet is included below to show what I was attempting.