Menu contextuel clic droit

[rudymagny]

Bonjour le forum,
J'utilise actuellement dans une feuille excel des boutons affectés à des macros permettant de colorier la cellule et d'écrire un commentaire dans les cellules sélectionnées.
Cependant j'ai tellement de boutons qu'il faut de la place sur la feuille.
Est il possible de créer un menu supplémentaire dans le menu contextuel "clic droit"?

Merci à vous

 

[MJ13]

Re : Menu contextuel clic droit

Bonjour Rudy

Oui, je l'ai déjà fait mais je n'ai pas le code sur place. Fais déja une recherche sur G....E ou sur XLD.

Ensuite tu nous dis où tu en es.

 

[rudymagny]

Re : Menu contextuel clic droit

J'ai trouvé ce code pour faire appel à une macro :

' 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 "Pain", "Pain"
End Sub

Mais ce code me fait une erreur de variable sur la ligne

Set Mc = CommandBars("Cell").Controls

?

 

[rudymagny]

Re : Menu contextuel clic droit

Bonjour MJ13, et merci pour la réponse.
J'ai trouvé le code précédemment cité mais je cherche pourquoi j'ai une erreur.

A savoir que j'ai mis le code dans le ThisWorkBook.

 

[rudymagny]

Re : Menu contextuel clic droit

Sinon j'ai trouvé ceci :

Private Sub Workbook_Open()
    Call Creer_Menu_Contextuel_2
End Sub

Sub Creer_Menu_Contextuel_2()

'réinitialize la sourie comme à l'origine
Application.CommandBars("Cell").Reset

'Crée une commande dans le menu
With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = "Pain" 'le nom de la commande
.BeginGroup = True 'ligne facultative si elle est précisée alors
.OnAction = "Pain" 'appel de la macro

.Caption = "Poste" 'le nom de la commande
.BeginGroup = True 'ligne facultative si elle est précisée alors
.OnAction = "Poste" 'appel de la macro

End With

End Sub

Mais ce code ne permet que d'ajouter une seule macro dans le menu contextuel.

Je cherche...

 

[Staple1600]

Re : Menu contextuel clic droit

Bonjour à tous

J'ai testé sous Excel 2000.

Ton code fonctionne


Pour remettre le clic-droit

Sub reset_menudroit()
CommandBars("Cell").Reset
End Sub

edition: bonjour Dull, MJ13

 

[rudymagny]

Re : Menu contextuel clic droit

Bonjour Staple1600, et merci pour le test.

Cependant ça me fait une erreur aussi sur :

CommandBars("Cell").Reset

A savoir que j'utilise excel 2002 et excel 2007

 

[rudymagny]

Re : Menu contextuel clic droit

Voici l'erreur en pièce jointe

 

[Dull]

Re : Menu contextuel clic droit

Salut, rudymagny, Michel, Stapple, le Forum

Essaye ce Code

Private Sub Workbook_Open()
Application.CommandBars("Cell").Reset
With Application.CommandBars("Cell").Controls.Add(msoControlButton)
    .Caption = "Rouge"
    .BeginGroup = True
    .OnAction = "Rouge"
End With
With Application.CommandBars("Cell").Controls.Add(msoControlButton)
    .Caption = "Bleu"
    .OnAction = "Bleu"
End With
With Application.CommandBars("Cell").Controls.Add(msoControlButton)
    .Caption = "Efface"
    .OnAction = "Efface"
End With
End Sub

Ajoute ce code à la fermeture du Fichier

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.CommandBars("Cell").Reset
End Sub

Au click droit, et seulement sur cet exemple, trois codes on été ajoutés Rouge, Bleu et Efface faisant appel à des macro colorant la cellule Active en Rouge, en Bleu ou efface les couleur.

Bonne Journée

 

[MJ13]

Re : Menu contextuel clic droit

Re, Bonjour JM, Ah Dull idem

Normalement comme ceci, tu en crées 2 (pas de problème avec XL2007):

Private Sub Workbook_Open()
    Call Creer_Menu_Contextuel_2
End Sub
Sub Creer_Menu_Contextuel_2()
'réinitialize la sourie comme à l'origine
Application.CommandBars("Cell").Reset
'Crée une commande dans le menu
With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = "Poste" 'le nom de la commande
.BeginGroup = True 'ligne facultative si elle est précisée alors
.OnAction = "Poste" 'appel de la macro
End With
With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = "Pain" 'le nom de la commande
.BeginGroup = True 'ligne facultative si elle est précisée alors
.OnAction = "Pain" 'appel de la macro
End With
End Sub

 

[rudymagny]

Re : Menu contextuel clic droit

Bonjour Dull, et merci pour le code ça marche nickel!!!

Tu as raison MJ13, c'est parce qu'il fallait que je rouvre le fichier pour qu'il mette le deuxième item.

Merci beaucoup à vous tous.

 

[rudymagny]

Re : Menu contextuel clic droit

Je vais aller un peu loin, mais pour optimiser le truc, je voudrais créer deux sous domaines : exemple :

Type 1
|
|
-->bleu
-->rouge

Type 2
|
|
-->vert
-->jaune

est ce possible?

 

[MJ13]

Re : Menu contextuel clic droit

Re

Et à la sortie d'Excel, pense à faire un reset de la barre click droit sur le Workbook_BeforeClose (dans la feuille ThisWorkbook), sinon, elle risque de ne pas disparaître lorsque tu rouvriras Excel.

Je vais aller un peu loin, mais pour optimiser le truc, je voudrais créer deux sous domaines : exemple :

Type 1
|
|
-->bleu
-->rouge

Type 2
|
|
-->vert
-->jaune

est ce possible?

Cela doit l'être mais surement plus complexe. Pas trop le temps, donc je laisse la main.

Bon Week-end.

 

[rudymagny]

Re : Menu contextuel clic droit

Merci MJ13, j'ai pensé au reset.

merci encore et bon week end.

 

[rudymagny]

Re : Menu contextuel clic droit

Bon après quelques recherches et tests, j'ai trouvé ceci :

' À mettre dans une module
Public MainMenu As CommandBarPopup      'Menu contextuel principal
Public SousMenu1 As CommandBarControl   '  1er Sous-menu à MainMenu
Public SousMenu2 As CommandBarControl   '  2e  Sous-menu à MainMenu
Sub SubMenu1()
    MsgBox "Sous-menu 1"
    
End Sub
Sub SubMenu2()
    MsgBox "Sous-menu 2"
End Sub
Sub EffacerMenus()
    Dim I As Integer
    
    For I = Application.CommandBars("cell").Controls.Count To 1 Step -1
        If Application.CommandBars("cell").Controls(I).Caption = "Test" Then
            Application.CommandBars("cell").Controls(I).Delete
        End If
    Next
    
End Sub

' À mettre dans ThisWorkbook
Private Sub Workbook_Deactivate()
    'Effacer les menus contextuels si on change de classeur
    EffacerMenus
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    'Effacer les menus contextuels si on ferme le classeur
    EffacerMenus
End Sub
' À mettre dans le code d'une feuille
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
   
    'Effacer les menus contextuels créés s'ils existent déjà
    EffacerMenus
    
    'Création d'un menu contextuel ajouté en premier aux autres d'Excel
    If Not Application.Intersect(Target, Range("A:AZ")) Is Nothing Then
        Set MainMenu = CommandBars("cell").Controls.Add _
                        (Type:=msoControlPopup, _
                        before:=1, _
                        temporary:=True)
            MainMenu.Caption = "Test"
        
        'Création du premier sous-menu affecté à MainMenu
        Set SousMenu1 = MainMenu.Controls.Add(Type:=msoControlButton)
            With SousMenu1
               .Caption = "1er sous-menu"   'Texte affiché
               .OnAction = "Submenu1"       'Nom de la macro
               .Tag = "Menu1"               'au besoin
            End With
        
        'Création du deuxième sous-menu toujours affecté à MainMenu
        Set SousMenu2 = MainMenu.Controls.Add(Type:=msoControlButton)
            With SousMenu2
               .Caption = "2e sous-menu"    'Texte affiché
               .OnAction = "Submenu2"       'Nom de la macro
               .Tag = "Menu2"               'au besoin
            End With
    
    End If
End Sub
Private Sub Worksheet_Deactivate()
    'Effacer les menus contextuels si on change de feuille
    EffacerMenus
End Sub

A adapter quand on veut plusieurs sous menus mais ça fonctionne impeccablement.