Option Explicit 'http://groups.google.com/groups?q=personal.xls+menu*+group:*excel*&hl=en&lr=&ie=UTF-8&oe=UTF-8&selm=u1%24c9J49BHA.1012%40tkmsftngp04 Sub RepairUserDefinedMenus() ' on website as code/repairuserdefinedmenus.txt 'Fixes reassigned personal.xls ' that get modified when redoing systems or Excel versions ' macro saves having to change assigned macros on menus and toolbar buttons ' when the path to xlstart\personal.xls changes ' Bernie Dietrick, 2002-04-18 ' David McRitchie, modification for multiple levels ' of menus (lvl), and for reporting (use of cells on worksheet) ' http://www.mvps.org/dmcritchie/excel/barhopper.htm ' http://www.mvps.org/dmcritchie/excel/barhopping.txt ' http://www.mvps.org/dmcritchie/excel/toolbars.htm (old code) Dim cmdBar As CommandBar Dim myControl As CommandBarControl Dim Lvl As Long, Kb As Long On Error GoTo ErrorReading: Dim FC As Long 'Found in False Count Lvl = 0 'recursion level Dim I As Long, j As Long FC = 0 If MsgBox("List on this sheet?", vbOKCancel, "Go?") <> vbOK Then Exit Sub Cells.Clear Cells(1, 1).Select Cells(1, 1).Value = "personal.xls!RepairUserDefinedMenus" Cells(1, 3) = "Caption" Cells(1, 4) = "ID" Cells(1, 5) = "ttiptext" Cells(1, 6) = "p/o" Cells(1, 7) = "type" Cells(1, 8) = "index" Cells(1, 9) = "name" Cells(1, 10) = "builtin" Cells(1, 11) = "action" Cells(1, 12) = "width" Cells(1, 13) = "KB" Cells(1, 14) = "Lvl" Cells(1, 15) = "Fc" Kb = 0 For Each cmdBar In CommandBars Kb = Kb + 1 For I = 1 To cmdBar.Controls.Count With cmdBar.Controls(I) If .BuiltIn = False Then If .Type = msoControlPopup Then Lvl = Lvl + 1 FC = 0 ' STUCK THIS IN HOPE IT WORKS For Each myControl In .Controls FC = FC + 1 ActiveCell.Offset(FC * 2 - 1, 0).Value = cmdBar.Position & " in " & cmdBar.Name If myControl.Type = 10 Then ActiveCell.Offset(FC * 2 - 1, 1) = "*menu*" Else j = InStr(myControl.OnAction, "!") If j > 0 Then ActiveCell.Offset(FC * 2 - 1, 1).Value = Mid(myControl.OnAction, j + 1) End If ActiveCell.Offset(FC * 2 - 1, 2).Value = myControl.Caption ActiveCell.Offset(FC * 2 - 1, 3).Value = myControl.ID ActiveCell.Offset(FC * 2 - 1, 4).Value = myControl.TooltipText ActiveCell.Offset(FC * 2 - 1, 5).Value = "PopUp" ' -- "Control Popup" ActiveCell.Offset(FC * 2 - 1, 6).Value = myControl.Type ActiveCell.Offset(FC * 2 - 1, 7).Value = myControl.Index ActiveCell.Offset(FC * 2 - 1, 8).Value = cmdBar.Name ActiveCell.Offset(FC * 2 - 1, 9).Value = cmdBar.BuiltIn ActiveCell.Offset(FC * 2 - 1, 10).Value = myControl.OnAction ActiveCell.Offset(FC * 2 - 1, 11).Value = cmdBar.Width ActiveCell.Offset(FC * 2 - 1, 12).Value = Kb ActiveCell.Offset(FC * 2 - 1, 13).Value = Lvl ActiveCell.Offset(FC * 2 - 1, 14).Value = FC If myControl.Type <> 10 Then j = InStr(1, myControl.OnAction, "personal.xls'!") ActiveCell.Offset(FC * 2 - 1, 15).Value = myControl.OnAction If j > 0 Then ActiveCell.Offset(FC * 2 - 1, 10).Value = myControl.OnAction myControl.OnAction = _ "personal.xls!" & Mid(myControl.OnAction, _ j + Len("'personal.xls'!")) ActiveCell.Offset(FC * 2, 10).Value = _ "personal.xls!" & Mid(myControl.OnAction, _ j + Len("'personal.xls'!")) End If ' J> 0 Lvl = Lvl - 1 End If '.type Next myControl Else FC = FC + 1 ActiveCell.Offset(FC * 2 - 1, 0).Value = I & " in " & cmdBar.Name On Error Resume Next j = InStr(.OnAction, "!") If j > 0 Then ActiveCell.Offset(FC * 2 - 1, 1).Value = Mid(.OnAction, j + 1) ActiveCell.Offset(FC * 2 - 1, 2).Value = .Caption ActiveCell.Offset(FC * 2 - 1, 3).Value = .ID ActiveCell.Offset(FC * 2 - 1, 4).Value = .TooltipText ActiveCell.Offset(FC * 2 - 1, 5).Value = "Other" ActiveCell.Offset(FC * 2 - 1, 6).Value = .Type ActiveCell.Offset(FC * 2 - 1, 7).Value = .Index ActiveCell.Offset(FC * 2 - 1, 8).Value = cmdBar.Name ActiveCell.Offset(FC * 2 - 1, 9).Value = cmdBar.BuiltIn ActiveCell.Offset(FC * 2 - 1, 10).Value = .OnAction ActiveCell.Offset(FC * 2 - 1, 11).Value = cmdBar.Width j = InStr(1, cmdBar.Controls(I).OnAction, "personal.xls'!") If j > 0 Then .OnAction = "'personal.xls'!" & Mid(.OnAction, _ j + Len("'personal.xls'!")) ActiveCell.Offset(FC * 2, 10).Value = _ "'personal.xls'!" & Mid(.OnAction, _ j + Len("'personal.xls'!")) ActiveCell.Offset(FC * 2, 10).Interior.Color = 34 End If ' J> 0 End If ' .type / ELS End If ' .builtin End With 'cmdbar ErrorReading: Next I Next cmdBar End Sub