John Walkenbach's MenuMaker Error
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, _
Befo=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
|