ExcelBanter - Toolbar Recorder

I did this some years ago.
There are 2 Subs, one for recording the menubar and one for restoring the
menubar from the Excel sheet data.
I am sure there are things that could be improved, but it will give you a
start.

RBS

Sub RecordMenuBar()

'puts all the menubar button properties in a table
Application.ScreenUpdating = False

Dim RW As Boolean
Dim CBC As CommandBarControl
Dim c As Variant
Dim C2 As Variant
Dim i As Byte
Dim m As Byte
Dim n As Integer

Range(Cells(1), Cells(1).SpecialCells(xlLastCell)).Clear

n = 1

Dim Msg, Style, Title, response
Msg = "RECORD WHOLE MENUBAR ?"
Style = vbYesNo + vbDefaultButton2 + vbQuestion
Title = " RECORD MENUBAR"

response = MsgBox(Msg, Style, Title)

If response = vbYes Then
RW = True
End If

On Error Resume Next
With Range(Cells(1), Cells(9))
.Font.Bold = True
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End With

Cells(1) = "Level"
Cells(2).Value = "Caption"
Cells(3).Value = "Index"
Cells(4).Value = "Type"
Cells(5).Value = "ID"
Cells(6).Value = "OnAction"
Cells(7).Value = "ShortcutText"
Cells(8).Value = "Width"
Cells(9).Value = "Style"

For Each CBC In CommandBars.ActiveMenuBar.Controls

If RW = True Then
n = n + 1

i = CBC.Index
Range(Cells(n, 1), Cells(n, 9)).Interior.ColorIndex = 6
Cells(n, 1).Value = "P"
Cells(n, 2).Value = CBC.Caption
Cells(n, 2).Font.Bold = True
Cells(n, 3).Value = i
Cells(n, 4).Value = CBC.Type
Cells(n, 5).Value = CBC.ID
Cells(n, 6).Value = _
Right(CBC.OnAction, _
Len(CBC.OnAction) - InStrRev(CBC.OnAction, "!"))
Cells(n, 7).Value = CBC.ShortcutText
Cells(n, 8).Value = CBC.Width
If CBC.Type = 1 Then
Cells(n, 9).Value = CBC.Style
Else
Cells(n, 9).Value = ""
End If
Else
If CBC.BuiltIn = False Then
n = n + 1
i = CBC.Index
Range(Cells(n, 1), Cells(n, 9)).Interior.ColorIndex = 6
Cells(n, 1).Value = "P"
Cells(n, 2).Value = CBC.Caption
Cells(n, 2).Font.Bold = True
Cells(n, 3).Value = i
Cells(n, 4).Value = CBC.Type
Cells(n, 5).Value = CBC.ID
Cells(n, 6).Value = _
Right(CBC.OnAction, _
Len(CBC.OnAction) - InStrRev(CBC.OnAction, "!"))
Cells(n, 7).Value = CBC.ShortcutText
Cells(n, 8).Value = CBC.Width
If CBC.Type = 1 Then
Cells(n, 9).Value = CBC.Style
Else
Cells(n, 9).Value = ""
End If
End If
End If

If CBC.Index = i And CBC.Type = 10 Or CBC.Type = 12 Then
For Each c In CommandBars.ActiveMenuBar.Controls(i).Controls
n = n + 1
m = c.Index
Range(Cells(n, 2), Cells(n, 9)).Interior.ColorIndex = 37
Cells(n, 1).Value = "S"
Cells(n, 2).Value = c.Caption
If c.Type = 10 Or c.Type = 12 Then
Cells(n, 2).Font.Bold = True
End If
Cells(n, 3).Value = m
Cells(n, 4).Value = c.Type
Cells(n, 5).Value = c.ID
Cells(n, 6).Value = _
Right(c.OnAction, _
Len(c.OnAction) - InStrRev(c.OnAction, "!"))
Cells(n, 7).Value = c.ShortcutText
Cells(n, 8).Value = c.Width
Cells(n, 9).Value = c.Style

If c.Index = m And c.Type = 10 Or c.Type = 12 Then
For Each C2 In
CommandBars.ActiveMenuBar.Controls(i).Controls(m). Controls
n = n + 1
Range(Cells(n, 3), Cells(n, 9)).Interior.ColorIndex
= 34
Cells(n, 1).Value = "T"
Cells(n, 2).Value = C2.Caption
Cells(n, 3).Value = C2.Index
Cells(n, 4).Value = C2.Type
Cells(n, 5).Value = C2.ID
Cells(n, 6).Value = _
Right(C2.OnAction, _
Len(C2.OnAction) - InStrRev(C2.OnAction, "!"))
Cells(n, 7).Value = C2.ShortcutText
Cells(n, 8).Value = C2.Width
Cells(n, 9).Value = C2.Style
Next
End If
Next
End If
Next

Columns("A:I").AutoFit

Application.ScreenUpdating = True

End Sub

Sub MakeMenuBar()

'make (custom)menubar from Excel table
Application.ScreenUpdating = False

Dim CBC As CommandBarControl
Dim i As Long
Dim strLevel As String
Dim strType As String
Dim strCaption As String
Dim ID As Long
Dim strOnAction As String
Dim strShortCut As String
Dim strWidth As String
Dim strStyle As Long
Dim P As Byte
Dim S As Byte
Dim T As Byte
Dim LR As Integer

LR = Cells(1).End(xlDown).Row

For Each CBC In CommandBars.ActiveMenuBar.Controls
If CBC.BuiltIn = False Then
CBC.Delete
End If
Next

For i = 2 To LR

strLevel = Cells(i, 1).Value
strCaption = Cells(i, 2).Value
strType = Cells(i, 4).Value
ID = Cells(i, 5).Value
If Not Cells(i, 6).Value = "" Then
strOnAction = _
Right(Cells(i, 6), _
Len(Cells(i, 6)) - InStrRev(Cells(i, 6), "!"))
Else
strOnAction = ""
End If
strShortCut = Cells(i, 7).Value
strWidth = Cells(i, 8).Value
If Not Cells(i, 9).Value = "" Then
strStyle = Cells(i, 9).Value
End If

With CommandBars("Worksheet Menu Bar")
Select Case strLevel
Case "P"

'position of the primary custom control (Index)
P = Cells(i, 3).Value

.Controls.Add Type:=strType, ID:=ID, _
befo=P
S = 0
.Controls(P).Caption = strCaption
.Controls(P).Width = strWidth
If Not Cells(i, 9).Value = "" Then
.Controls(P).Style = strStyle
End If
If Not strShortCut = "" Then
.Controls(P).ShortcutText = strShortCut
End If
If Not strOnAction = "" Then
.Controls(P).OnAction = strOnAction
End If
Case "S"
With .Controls(P)
.Controls.Add Type:=strType, ID:=ID
S = S + 1
T = 0
.Controls(S).Caption = strCaption
.Controls(S).Width = strWidth
If Not Cells(i, 9).Value = "" Then
.Controls(S).Style = strStyle
End If
If strType = 1 Then
If Not strOnAction = "" Then
.Controls(S).OnAction = strOnAction
End If
If Not strShortCut = "" Then
.Controls(S).ShortcutText = strShortCut
If Not .Controls(S).OnAction = "" Then
'assign keyboard shortcut
Application.MacroOptions _
Macro:=.Controls(S).OnAction, _
HasShortcutKey:=True, _
ShortcutKey:=Right(strShortCut, 1)
End If
End If
End If
End With
Case "T"
With .Controls(P).Controls(S)
.Controls.Add Type:=strType, ID:=ID
T = T + 1
.Controls(T).Caption = strCaption
.Controls(T).Width = strWidth
If Not Cells(i, 9).Value = "" Then
.Controls(T).Style = strStyle
End If
If strType = 1 Then
.Controls(T).Style = msoButtonIconAndCaption
If Not strOnAction = "" Then
.Controls(T).OnAction = strOnAction
End If
If Not strShortCut = "" Then
.Controls(T).ShortcutText = strShortCut
If Not .OnAction = "" Then
'assign keyboard shortcut
Application.MacroOptions _
Macro:=.Controls(T).OnAction, _
HasShortcutKey:=True, _
ShortcutKey:=Right(strShortCut, 1)
End If
End If
End If
End With
End Select
End With
Next i

Application.ScreenUpdating = True

End Sub

"jason" wrote in message
om...
Would it be possible to set up some way of recording all toolbars and
their positions so that when I use a new profile I could run a routine
and Excel would look the way I like it. I think it's have to pass on
any custom buttons connected to add-ins.
I'm just after pointers and general methods of doing this i.e use the
registary or just a worksheet, and whether there'd be any real value
in having a go at this?

Jason