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
|