Microsoft 365 Création d'une barre personnalisée dans Excel

Sub CommandBarreCréerAvecBoutonEtMenu()
    Dim LaBarre As CommandBar
    Dim Moncontrol As Object
    Dim lignebar(1 To 3) As CommandBar

    deleteBars

    'on créée 3 barres
    Set lignebar(1) = Application.CommandBars.Add
    Set lignebar(2) = Application.CommandBars.Add
    Set lignebar(3) = Application.CommandBars.Add


    With lignebar(1)
        .Name = "Barredonnée1"
        Set Moncontrol = .Controls.Add(msoControlButton, , , , True)
        With Moncontrol
            .Style = msoButtonIconAndCaption
            .Caption = "Ajouter une donnée"
            .OnAction = "Macro1"
            .FaceId = 989
        End With

        Set Moncontrol = .Controls.Add(msoControlPopup, , , , True)
        With Moncontrol
            .Caption = "menu Format de donnée"

            For i = 1 To 5
                Set itemmenu = .Controls.Add(msoControlButton, , , , True)
                With itemmenu
                    .Style = msoButtonIconAndCaption
                    .Caption = "format" & i
                    .OnAction = "Macro1"
                    .FaceId = 989
                End With
            Next

        End With



        .Visible = True
    End With

    With lignebar(2)
        .Name = "Barredonnée2"
        Set Moncontrol = .Controls.Add(msoControlButton, , , , True)
        With Moncontrol
            .Style = msoButtonIconAndCaption
            .Caption = "Modifier une donnée"
            .OnAction = "Macro2"
            .FaceId = 989
        End With
        .Visible = True
    End With

    With lignebar(3)
        .Name = "Barredonnée3"
        Set Moncontrol = .Controls.Add(msoControlButton, , , , True)
        With Moncontrol
            .Style = msoButtonIconAndCaption
            .Caption = "Supprimer une donnée"
            .OnAction = "Macro2"
            .FaceId = 989
        End With
        .Visible = True
    End With
End Sub

Sub deleteBars()
    Dim i&
    For i = 1 To 3
        On Error Resume Next
        CommandBars("Barredonnée" & i).Delete
    Next
End Sub

Private Sub Workbook_Open()
' Déclaration des variables
  Dim Cbar As CommandBar
  Dim Cbut As CommandBarButton
  Dim Cpop1 As CommandBarPopup

' Création de la barre de menus
    Set Cbar = Application.CommandBars.Add(Name:="MaBarre", Position:=msoBarTop, Temporary:=True)
        Cbar.Protection = msoBarNoMove + msoBarNoCustomize '<-- protection de la barre de menus'insertion sur la barre de menus d'un bouton de commande

' Insertion sur la barre de menus "Shapes"
    Set Cpop1 = Cbar.Controls.Add(msoControlPopup)
        With Cpop1
            .Caption = "Shapes" '<-- label du menu
            .Tag = "smShps" '<-- étiquette
        End With

' Insertion dans le sous-menu (Des Différentes Méthodes des traitements des Shapes)
    Set Cpop1 = Cpop1.Controls.Add(msoControlPopup)
        With Cpop1
            .Caption = "LesMethodes" '<-- label du sous-menu
            .Tag = "smShps1" '<-- étiquette
            .BeginGroup = True '<-- barre de séparation
        End With

' Insertion dans les sous-sous-menu  (Méthodes 1 traitement des Shapes)
    Set Cbut = Cpop1.Controls.Add(Type:=msoControlButton, ID:=165)
        With Cbut
            .Style = msoButtonIconAndCaption '<-- bouton avec icône + texte
            .Caption = "GrouperShapes" '<-- label du bouton
            .OnAction = "Ecrire ici le nom du module vba" '<-- procédure à exécuter
        End With

' Affichage de la barre de menus
        Cbar.Visible = True

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
' Destruction de cette barre à la fermeture du Classeur Excel au moyen de cette Macro.
    On Error Resume Next
        Application.CommandBars("MaBarre").Delete
    On Error GoTo 0
End Sub

Sub A0_GouperShapes()
' Selection a l'écran des Shapes devant être regroupé dans l'emprise d'uneplage
'
Dim Forme As Shape
Dim LesFormes As ShapeRange
Dim ListeForme() As Variant
    ReDim ListeForme(0)
Dim ma_selection As Range
    Set ma_selection = Application.InputBox("choissiez une cellule ou une plage", Type:=8)
Dim ws As Worksheet
    Set ws = Worksheets(ma_selection.Parent.Name)
Dim PlageForme As Range
'
    On Error GoTo errorHandler
    For Each Forme In ws.Shapes
        Set PlageForme = Range(Forme.TopLeftCell.Address, Forme.BottomRightCell.Address)
            If Not Intersect(ma_selection, PlageForme) Is Nothing Then
                ListeForme(UBound(ListeForme)) = Forme.Name
                ReDim Preserve ListeForme(UBound(ListeForme) + 1)
            End If
    Next Forme
' Suppimé la derniére dimension qui est vide
    ReDim Preserve ListeForme(UBound(ListeForme) - 1)
' Création des Groupes pour les Formes (De la Plage de sélèction)
    ws.Shapes.Range(ListeForme).Group.Select
' Créer une variable pour les formes groupé
    Set LesFormes = Selection.ShapeRange
' Créer un nom a se groupe
    LesFormes.Name = "Image - " & Split(LesFormes.Name, " ")(1)
'
'   Permet de sortir de la procédure et évite la gestion d'erreur (errorHandler), si la macro
'   s'est déroulée sans encombre.
        Exit Sub
'
errorHandler:
'indique le numéro et la description de l'erreur survenue
    'MsgBox Err.Number & vbLf & Err.Description
    MsgBox "Aucune Shapes dans la zone de selection Ou Une seule Shapes Sélectionné."
End Sub