Publicité
+ Répondre à la discussion
Affichage des résultats 1 à 5 sur 5
  1. #1
    Expert Confirmé Sénior
    Avatar de patricktoulon
    Profil pro patrick
    Inscrit en
    avril 2009
    Messages
    3 556
    Détails du profil
    Informations personnelles :
    Nom : patrick
    Âge : 44
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Secteur : Bâtiment

    Informations forums :
    Inscription : avril 2009
    Messages : 3 556
    Points : 6 095
    Points
    6 095

    Par défaut

    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
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : résolu: ça peut servir aux autres
    et n'oublie pas de voter

  2. #2
    Membre Expert Avatar de QuestVba
    Homme Profil pro Lionel
    Enseignant
    Inscrit en
    juillet 2012
    Messages
    1 163
    Détails du profil
    Informations personnelles :
    Nom : Homme Lionel
    Âge : 44
    Localisation : Belgique

    Informations professionnelles :
    Activité : Enseignant
    Secteur : Service public

    Informations forums :
    Inscription : juillet 2012
    Messages : 1 163
    Points : 1 931
    Points
    1 931

    Par défaut

    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

  3. #3
    Expert Confirmé Sénior
    Avatar de patricktoulon
    Profil pro patrick
    Inscrit en
    avril 2009
    Messages
    3 556
    Détails du profil
    Informations personnelles :
    Nom : patrick
    Âge : 44
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Secteur : Bâtiment

    Informations forums :
    Inscription : avril 2009
    Messages : 3 556
    Points : 6 095
    Points
    6 095

    Par défaut 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
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : résolu: ça peut servir aux autres
    et n'oublie pas de voter

  4. #4
    Membre Expert Avatar de QuestVba
    Homme Profil pro Lionel
    Enseignant
    Inscrit en
    juillet 2012
    Messages
    1 163
    Détails du profil
    Informations personnelles :
    Nom : Homme Lionel
    Âge : 44
    Localisation : Belgique

    Informations professionnelles :
    Activité : Enseignant
    Secteur : Service public

    Informations forums :
    Inscription : juillet 2012
    Messages : 1 163
    Points : 1 931
    Points
    1 931

    Par défaut

    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

  5. #5
    Expert Confirmé Sénior
    Avatar de patricktoulon
    Profil pro patrick
    Inscrit en
    avril 2009
    Messages
    3 556
    Détails du profil
    Informations personnelles :
    Nom : patrick
    Âge : 44
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Secteur : Bâtiment

    Informations forums :
    Inscription : avril 2009
    Messages : 3 556
    Points : 6 095
    Points
    6 095

    Par défaut re

    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
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : résolu: ça peut servir aux autres
    et n'oublie pas de voter

Liens sociaux

Règles de messages

  • Vous ne pouvez pas créer de nouvelles discussions
  • Vous ne pouvez pas envoyer des réponses
  • Vous ne pouvez pas envoyer des pièces jointes
  • Vous ne pouvez pas modifier vos messages
  •