Archives de l’auteur : Gaetan Mourmant

Ajouter un menu contextuel (clic droit) à plusieurs niveaux de sous-menus

de | |
Écrire un commentaire

Voici une question qui m'a pas mal travaillée et qui demande une compréhension fine de la différence entre msoControlButton et msoControlPopup. Une fois qu'on a compris, c'est "relativement" simple. msoControlButton fait référence à un bouton, alors que msoControlPopup fait référence à un pop-up qui va servir de parent du sous-menu

Vous pouvez télécharger le fichier directement ici.

menucontextuel3niveauxTélécharger

Explication en vidéo:

Notez que l'on peut utiliser le with et end with, ou alors faire référence directement au nom du sous menu. Je pense que c'est une question de préférence personnelle. With et end with est en principe plus rapide à exécuter, mais dans ce type de situation, je ne pense pas que la différence soit perceptible.

Emplacement du code

Voici le code avec des exemples de sous-menu :

Dans Thisworkbook, on peut mettre ce code : 

Private Sub Workbook_Activate()
    Call AddToCellMenu
End Sub

Private Sub Workbook_Deactivate()
    Call DeleteFromCellMenu
End Sub

Dans un nouveau module, on mettra ce code : 

Option Explicit

Sub AddToCellMenu()
    Dim ContextMenu As CommandBar
    Dim MyMenu As CommandBarControl
    Dim MySubMenu_Niv1 As CommandBarControl
    Dim MySubMenu_Niv2 As CommandBarControl

    'On supprime le menu s'il existe
    Call DeleteFromCellMenu

    'ContextMenu est lié au clic droit sur une cellule
    Set ContextMenu = Application.CommandBars("Cell")

    'TRES IMPORTANT, il faut utiliser un msoControlPopup pour le sous menu, sinon ca ne fonctionnera pas.
    Set MyMenu = ContextMenu.Controls.Add(Type:=msoControlPopup, before:=1)
    With MyMenu
        .Caption = "Menu-Cartes"
        .Tag = "My_Cell_Control_Tag" 'on utilise ce tag par la suite pour supprimer le menu

        'TRES IMPORTANT, il faut utiliser un msoControlPopup pour le sous menu, sinon ca ne fonctionnera pas.
        Set MySubMenu_Niv1 = .Controls.Add(Type:=msoControlPopup)
        MySubMenu_Niv1.Caption = "SousMenu1"
       
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "NomMacro1"
            .FaceId = 481
            .Caption = "Bouton1"
        End With
    End With
    
    'creation du sous menu 2, a l'interieur du sous menu 1
    Set MySubMenu_Niv2 = MySubMenu_Niv1.Controls.Add(msoControlPopup)
    MySubMenu_Niv2.Caption = "SousMenu2"
    
    With MySubMenu_Niv1
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "NomMacro2"
            .FaceId = 482
            .Caption = "Bouton2"
        End With
    End With
        
    'creation du sous menu 3, a l'interieur du sous menu2
    With MySubMenu_Niv2
        With .Controls.Add(Type:=msoControlButton)
            .OnAction = "'" & ThisWorkbook.Name & "'!" & "NomMacro3"
            .FaceId = 483
            .Caption = "Bouton3"
        End With
    End With
    
    'Add seperator to the Cell menu
    ContextMenu.Controls(2).BeginGroup = True
End Sub
Sub DeleteFromCellMenu()
    Dim ContextMenu As CommandBar
    Dim ctrl As CommandBarControl

    'ContextMenu est lié au clic droit sur une cellule
    Set ContextMenu = Application.CommandBars("Cell")

    'Delete custom controls with the Tag : My_Cell_Control_Tag
    For Each ctrl In ContextMenu.Controls
        If ctrl.Tag = "My_Cell_Control_Tag" Then
            ctrl.Delete
        End If
    Next ctrl
End Sub
Sub NomMacro1()
    MsgBox "Coeur", vbOKOnly
End Sub
Sub NomMacro2()
    MsgBox "Carreaux", vbOKOnly
End Sub
Sub NomMacro3()
    MsgBox "Trèfle", vbOKOnly
End Sub

Sources :

https://www.rondebruin.nl/win/s6/win001.htm

https://docs.microsoft.com/en-us/office/vba/api/office.commandbarpopup