John Walkenbach's MenuMaker Error

[Sprinks]

I created a "macros.xls" file that defines a few dozen macros for use by our
workgroup. On a hidden and locked sheet of the workbook is a custom menu for
use by John Walkenbach's MenuMaker program. The file is maintained on the
network, and each user copies it to his XLStart folder.

Last week, a user was attempting to log off to catch a train, his computer
froze, and so he flipped the switch rather than his normal Log Off procedure.
Today, the macros file no longer automatically loaded. If loaded manually,
it triggered an error in the following CreateMenu() code on the line:

MenuItem.OnAction = PositionOrMacro

under Case 2.

I deleted his macros.xls, and recopied it from the network with no change.
I then moved the file to a new folder, and configured Excel under the Tools,
Options, <General Tab> to load all files from the folder on startup. Under
this config, the file loads normally.

Does anyone have any ideas as to why it won't load and operate properly from
the XLStart folder?


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)

' ****** ERROR TRIGGERS HERE ********
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

 

[Dave Peterson]

Just a guess, but I'd look for a problem in that worksheet--not the code.

I'd add this line right before the offending line:
MsgBox Row

You may get a few msgboxes to dismiss, but you'll see the row that caused the
trouble right before it blows up.

And in John's code, you're in a section that says the current index is 2 (column
A) and the next level isn't a 3. (I'm not sure that will add anything once you
see the problem row, though.)

 

[Sprinks]

Dave,

Thank you for your reply.

It crashes on the first menu item below (Asterisk), resulting in an empty
toolbar. Moreover, the file is the same as everyone else's. I post the
latest version to a network folder location, and the users copy it to their
XLStart folder.

When you originally answered this question, I couldn't figure out why his
crashed when noone else's did, but since creating a new folder and
configuring Excel to look there worked, I stopped looking. However, today it
no longer works, and while creating a new folder and reconfiguring Excel
works again, I don't want to keep supporting this ad infinitum and would like
to get to the bottom of it.

The only difference I can find is the following:

My system: Excel 2003 (11-8012-6568) SP2
His system: Excel 2003 (11-6560-6568) SP2

Do you have any ideas? I've posted the first few lines of the MenuSheet and
the CreateMenu code for your reference.

Thank you.
Sprinks

Level Caption Position/Macro Divider FaceID
1 &MacroMenu 10
2 A&sterisk Asterisk
2 &Alphanumeric Sort AlphaSort 210
2 Category Sub&totals CatSubtotals 226

Sub CreateMenu()
' This sub should be executed when the workbook is opened.
' NOTE: There is no error handling in this subroutine
On Error GoTo ErrHandler

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

ErrExit:
Exit Sub

ErrHandler:
MsgBox "There has been the following error. Please contact the macro
administrator." & _
vbCrLf & vbCrLf & Err.Number & vbCrLf & " " & Err.Description &
vbCrLf & _
"CreateMenu"
Resume ErrExit

End Sub

 

[Dave Peterson]

I don't have any other suggestions.

Dave,

Thank you for your reply.

It crashes on the first menu item below (Asterisk), resulting in an empty
toolbar. Moreover, the file is the same as everyone else's. I post the
latest version to a network folder location, and the users copy it to their
XLStart folder.

When you originally answered this question, I couldn't figure out why his
crashed when noone else's did, but since creating a new folder and
configuring Excel to look there worked, I stopped looking. However, today it
no longer works, and while creating a new folder and reconfiguring Excel
works again, I don't want to keep supporting this ad infinitum and would like
to get to the bottom of it.

The only difference I can find is the following:

My system: Excel 2003 (11-8012-6568) SP2
His system: Excel 2003 (11-6560-6568) SP2

Do you have any ideas? I've posted the first few lines of the MenuSheet and
the CreateMenu code for your reference.

Thank you.
Sprinks

Level Caption Position/Macro Divider FaceID
1 &MacroMenu 10
2 A&sterisk Asterisk
2 &Alphanumeric Sort AlphaSort 210
2 Category Sub&totals CatSubtotals 226

Sub CreateMenu()
' This sub should be executed when the workbook is opened.
' NOTE: There is no error handling in this subroutine
On Error GoTo ErrHandler

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

ErrExit:
Exit Sub

ErrHandler:
MsgBox "There has been the following error. Please contact the macro
administrator." & _
vbCrLf & vbCrLf & Err.Number & vbCrLf & " " & Err.Description &
vbCrLf & _
"CreateMenu"
Resume ErrExit

End Sub