Comment trouver le nom d'un boutons du ruban par son id

Version imprimable

04/02/2013, 15h02
patricktoulon

bonjour a tous

je cherche depuis deux jour mais sans succès
comment trouver le nom d'un boutons du ruban par son id

en effet dans la faq excel on trouve les commandbars et aussi comment exécuter l'action d'un control du ruban par macro mais par son nom
hors moi je n'ai que le faceID sachant que l'id du bouton est le meme dap'res la faq

une idée????

merci pour le retour
au plaisir

re
pour etre plus preci je souhaite executer la commande du control en ne connaissant que son idée
au plaisir

Bonjour,

J'ai aperçu ceci un jour. C'set un début

Code:

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
Sub ShowFaceIDs()
    Dim NewToolbar As CommandBar
    Dim NewButton As CommandBarButton
    Dim i As Integer, IDStart As Integer, IDStop As Integer
 
'   Delete existing FaceIds toolbar if it exists
    On Error Resume Next
    Application.CommandBars("FaceIds").Delete
    On Error GoTo 0
 
'   Add an empty toolbar
    Set NewToolbar = Application.CommandBars.Add _
        (Name:="FaceIds", temporary:=True)
    NewToolbar.Visible = True
 
'   Change the following values to see different FaceIDs
    IDStart = 1
    IDStop = 250
 
    For i = IDStart To IDStop
        Set NewButton = NewToolbar.Controls.Add _
            (Type:=msoControlButton, ID:=2950)
        NewButton.FaceId = i
        NewButton.Caption = "FaceID = " & i
    Next i
    NewToolbar.Width = 600
End Sub

Mettre en gras cellule

Code:

CommandBars.FindControl(ID:=113).Execute

04/02/2013, 15h39
patricktoulon

re

bonjour questvba

exellent!
c'etait ca que je cherchait
le findcontrol par le ID

Code:

CommandBars.FindControl(ID:=XXX).Execute

cela dit je ne sais par pourquoi selon le id j'ai une erreur

merci pour le retour

au plaisir

Bonjour,

Quelle type d'erreur ? Avec quel ID ?

J'ai aussi trouvé ceci pour le id des barre de menus d'Excel

Code:

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

bonjour questvba

en fait tout les id ne sont pas disponible en action sertains sont latant

alors dans le meme style de ton exemple je me suis fait un listeur de commandbars disponible avec leurs controls

vois par toi meme

Code:

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
 
 
Sub liste_commandbar_et_ces_controls()
    Dim cmb As CommandBar, n As Long, couleur As Variant, oldnamebar As String
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Sheets(1).Delete
        With Sheets(1)
        .Columns("A:D").ColumnWidth = 25
        .Columns("A:D").HorizontalAlignment = xlCenter
        n = 2
        Cells(1, 1) = "nom de la barre"
        Cells(1, 2) = "Id du control"
        Cells(1, 3) = "icon du control"
        Cells(1, 4) = "text du control"
        Cells(1, 5) = "type du control"
        For Each cmb In Application.CommandBars
            For Each ctrl In Application.CommandBars(cmb.Name).Controls
                n = n + 1
                Cells(n, 1) = cmb.Name & "____" & cmb.Type
                If Cells(n, 1) <> Cells(n - 1, 1) Then couleur = (Rnd * 54) + 2
                Sheets(1).Range("a" & n & ":e" & n).Interior.ColorIndex = couleur
                Cells(n, 2) = ctrl.ID
                On Error Resume Next
                Cells(n, 3) = ctrl.FaceId
                Cells(n, 4) = ctrl.Caption
                Cells(n, 5) = ctrl.Type
                ctrl.CopyFace
                .Paste
                .Shapes(.Shapes.Count).Top = Cells(n, 3).Top
                .Shapes(.Shapes.Count).Left = Cells(n, 3).Left + 5
                On Error GoTo 0
            Next ctrl
        Next cmb
    End With
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
        .FreezePanes = True
    End With
End Sub

qu'en pense tu ?

au plaisir