Menu contextuel clic droit

rudymagny

XLDnaute Occasionnel
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
 

rudymagny

XLDnaute Occasionnel
Re : Menu contextuel clic droit

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

Code:
' 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
Code:
Set Mc = CommandBars("Cell").Controls

?
 

rudymagny

XLDnaute Occasionnel
Re : Menu contextuel clic droit

Sinon j'ai trouvé ceci :

Code:
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

XLDnaute Barbatruc
Re : Menu contextuel clic droit

Bonjour à tous

J'ai testé sous Excel 2000.

Ton code fonctionne


Pour remettre le clic-droit
Code:
Sub reset_menudroit()
CommandBars("Cell").Reset
End Sub

edition
: bonjour Dull, MJ13 ;)
 
Dernière édition:

Dull

XLDnaute Barbatruc
Re : Menu contextuel clic droit

Salut, rudymagny, Michel, Stapple, le Forum

Essaye ce Code

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

Code:
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
 

Pièces jointes

  • ClickDroit.zip
    8.8 KB · Affichages: 136
  • ClickDroit.zip
    8.8 KB · Affichages: 147
  • ClickDroit.zip
    8.8 KB · Affichages: 153
Dernière édition:

MJ13

XLDnaute Barbatruc
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):

Code:
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
 

MJ13

XLDnaute Barbatruc
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

XLDnaute Occasionnel
Re : Menu contextuel clic droit

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

Code:
' À 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.
 

Discussions similaires

Statistiques des forums

Discussions
312 895
Messages
2 093 385
Membres
105 715
dernier inscrit
Yoenai