Private Sub Workbook_Open()
    Dim CmdBar As CommandBar
    Dim Bouton As CommandBarButton
    
    'Création de la barre d'outils nommée 'MaBarrePerso'
    Set CmdBar = Application.CommandBars _
        .Add(Name:="MaBarrePerso", Position:=msoBarTop, Temporary:=True)
    
    'Ajout de 3 boutons dans la barre d'outils
    Set Bouton = CmdBar.Controls.Add(Type:=msoControlButton)
    With Bouton
        'Définit "l'image" qui va s'afficher sur le bouton
        .FaceId = 133
        'Définit quelle macro est associée au bouton.
        'Cette macro sera lancée à chaque fois que vous cliquez sur le bouton.
        .OnAction = "Macro1"
    End With
    
    Set Bouton = CmdBar.Controls.Add(Type:=msoControlButton)
    With Bouton
        .FaceId = 134
        .OnAction = "Macro2"
    End With
    
    Set Bouton = CmdBar.Controls.Add(Type:=msoControlButton)
    With Bouton
         .FaceId = 135
        .OnAction = "Macro3"
    End With
    
    CmdBar.Visible = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    Application.CommandBars("MaBarrePerso").Delete
End Sub

Sub CreationBarre()
    Dim cbBarre As CommandBar
    Dim CB_B1 As CommandBarButton, CB_B2 As CommandBarButton
    Dim CB_B3 As CommandBarButton
    
    Set cbBarre = CommandBars _
        .Add(Name:="Ma barre perso", Position:=msoBarTop, Temporary:=True)
    
    Set CB_B1 = cbBarre.Controls.Add(Type:=msoControlButton)
    With CB_B1
        .FaceId = 353
        .Tag = "Premier bouton"
        .OnAction = "TestMacro"
    End With
    
    Set CB_B2 = cbBarre.Controls.Add(Type:=msoControlButton)
    With CB_B2
        .FaceId = 351
        .Tag = "Deuxième bouton"
        .OnAction = "TestMacro"
    End With
    
    Set CB_B3 = cbBarre.Controls.Add(Type:=msoControlButton)
    With CB_B3
        .FaceId = 352
        .Tag = "Troisième bouton"
        .OnAction = "TestMacro"
    End With
    
    cbBarre.Visible = True
End Sub


Sub TestMacro()
    MsgBox CommandBars.ActionControl.Tag
End Sub


Sub SuppressionBarre()
    On Error Resume Next
    CommandBars("Ma barre perso").Delete
End Sub

' Rajout d'une entrée dans menu contextuel
'
Function MenuCell(stCde As String, stMess As String)
    Dim Mc As CommandBarControls
    Dim Bo As CommandBarButton

    Set Mc = CommandBars("Cell").Controls
    Set Bo = Mc.Add(msoControlButton, Temporary:=True)
    Bo.Caption = stMess
    Bo.OnAction = stCde
End Function

 
'Initialisation dans l'évènement Workbook_open
'
Private Sub Workbook_Open()
    MenuCell "AjoutePrefixe", "Ajouter Prefixe"
End Sub

' Fonction exemple..
'
Sub AjoutePrefixe()
    Dim Pre As String
    Dim s As Range, c As Object

   Pre = InputBox("prefixe")
       Set s = Selection
       For Each c In s
          c.Value = Pre & c.Value
       Next
End Sub

Application.CommandBars("cell").Reset

Application.CommandBars("Worksheet Menu Bar").Enabled = True

Dim Cb As CommandBar
 
For Each Cb In Application.CommandBars
    If Cb.BuiltIn = True Then
        Cb.Enabled = True
    End If
Next

Sub Liste_FaceIDs()
    Dim tBar As CommandBar
    Dim i As Long

    'Supprime la barre d'outils temporaire si elle existe.
    On Error Resume Next
    Application.CommandBars("BarreTemp").Delete
    On Error GoTo 0
    
    'Supprime le contenu de la feuille
    Worksheets("Feuil1").Pictures.Delete
    Worksheets("Feuil1").Cells.ClearContents
    Application.ScreenUpdating = False
    
'   Add an empty toolbar
    Set tBar = Application.CommandBars.Add(Name:="BarreTemp")

    For i = 1 To 1870
        On Error Resume Next
        'Supprime le bouton précédent
        tBar.Controls(1).Delete
        On Error GoTo 0
        
        'Crée un nouveau bouton dans la barre d'outils
        With tBar.Controls.Add(Type:=msoControlButton)
            'Ajoute un FaceID
            .FaceId = i
            'Copie le FaceID
            .CopyFace
        End With
        
        'Effectue le collage dans la feuille
        Worksheets("Feuil1").Paste
        
        'Repositionne et nomme la nouvelle forme collée
        With Worksheets("Feuil1").Shapes(i)
            .Top = Cells(i, 1).Top
            .Left = 15
            .Name = "ID_" & i
        End With
        
    Next i
    
    'Supprime la barre d'outils temporaire
    Application.CommandBars("BarreTemp").Delete
    Application.ScreenUpdating = True
    
    MsgBox "Terminé."
End Sub