Archives de la catégorie : Divers

Private Sub Workbook_Activate()
    Call AddToCellMenu
End Sub

Private Sub Workbook_Deactivate()
    Call DeleteFromCellMenu
End Sub

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