1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131
| 'toutes les commandes de la barre de menus d'Excel dans une feuille de calcul !
'(y compris celles qui correspondent à des fonctionnalités non disponibles...)
Sub RecordMenuBar()
'RB Smissaert, mpep
'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, 3).Value = i
Cells(n, 4).Value = CBC.Type
Cells(n, 5).Value = CBC.ID
Cells(n, 6).Value = 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, 3).Value = i
Cells(n, 4).Value = CBC.Type
Cells(n, 5).Value = CBC.ID
Cells(n, 6).Value = 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
Cells(n, 3).Value = M
Cells(n, 4).Value = C.Type
Cells(n, 5).Value = C.ID
Cells(n, 6).Value = 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 = 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
Application.ScreenUpdating = True
End Sub |