VBA EXCEL - GESTION DE MENUS CONTEXTUELS (CLIC-DROIT) PRÊTE À L'EMPLOI ET FACILE À PARAMÈTRER

---

Commentaire sur cette source (4)
Ajouter un commentaire et/ou une note

Cette source est contenue dans un modèle de classeur Excel. Elle a à la fois un but pédagogique (comprendre par l'exemple les mécanismes de base des menus contextuels) et pratique par son côté KIT prêt à l'emploi.

Le principe : Dans une feuille du modèle (masquée par défaut) figure une plage de cellule qui contient la liste des options des menus contextuels. C'est dans cette plage que le code va chercher pour créer le menu contextuel. Donc l'ajout, le déplacement, la suppression des options dans les menus contextuels se fait directement dans la feuille, sans toucher au code.

Sont intégrés :
-La gestion de plusieurs menus
-L'affectation de menus particuliers à certaines feuilles
-La gestion des séparateurs de groupes
-La possibilité de choisir les options activées ou non activées au démarrage
-La gestion des options communes à tous les menus
-La désactivation et la réactivation des menus personnalisés
-Des exemples d'accès aux options de menu par VBA (pour activer/désactiver, sélectionner/désélectionner, afficher/masquer... les options des menus par programme)

'==============================================
' Dans le module MenusContextuels
'==============================================
Option Explicit
Public mcMenusOuiNon As Boolean
Public Const mcDébutNom = "mc"
Public Const mcCommun = "mcCommun"
Public Const mcStandard = "mcStandard"
Public Const mcPlageMenus = "mcMenus"
Public Const mcPlageFeuilles = "mcFeuilles"
Public Const mcNomFeuilleMenus = "mcMenusContextuels"

' Procédure de création des menus contextuels temporaires
' cette procedure est appelée à l'ouverture du classeur
' (Cf la Procedure WorkBook_Open du module de classe ThisWorkBook)
Sub mcCreationMenus()
    'On Error GoTo Erreur
    Dim B As CommandBar
    Dim C As CommandBarControl
    Dim L As Single
    Dim n As String
    ' suppression de toutes les barres contextuelles mc
    For Each B In Application.CommandBars
        If Left(B.Name, Len(mcDébutNom)) = mcDébutNom And B.Position = msoBarPopup Then
            B.Delete
        End If
    Next B
    ' Ajout des barres de menu contextuel figurant dans la plage mcMenus
    ' le nom est dans la première colonne de la plage
    ' Position:=msoBarPopup indique qu'il s'agit d'un menu contextuel
    With Range(mcPlageMenus)
        ' on lit toutes les lignes de la plage
        n = ""
        For L = 1 To .Rows.Count
            ' s'il s'agit d'un nouveau menu
            If Not IsEmpty(.Cells(L, 1)) Then
                ' on vérifie si le nom du menu est correct
                ' (sauf si on est sur la dernière ligne de la plage)
                If L <> .Rows.Count And (Left(.Cells(L, 1), Len(mcDébutNom)) <> mcDébutNom Or _
                    InStr(1, .Cells(L, 1), " ") > 0) Then
                    MsgBox "Vérifier les noms des menus SVP"
                    Exit Sub
                End If
                ' s'il ne s'agit pas du menu mcCommun
                ' on ajoute les options de ce dernier au menu précédent
                ' avant d'en créer un nouveau
                If n <> "" And n <> mcCommun Then mcAjouteOptionsCommun n
                ' la dernière ligne de la plage n'est pas un menu
                If L = .Rows.Count Then Exit Sub
                ' on crée le nouveau menu
                n = .Cells(L, 1)
                Set B = Application.CommandBars.Add(Name:=n, Position:=msoBarPopup, Temporary:=True)
            End If
            ' on ajoute une option de menu
            Set C = B.Controls.Add
                ' on définit ses propriétés
                C.Tag = .Cells(L, 2)        ' Définit la référence interne du contrôle qui
                                            ' peut être utilisé ensuite avec la méthode FindControl
                C.Caption = .Cells(L, 3)    ' Définit le texte du menu (3ème colonne de la plage)
                C.OnAction = .Cells(L, 4)   ' Définit la procédure liée (4ème colonne de la plage)
                C.BeginGroup = .Cells(L, 5) ' Indique si cette option est le début d'un groupe
                                            ' (présence d'un trait de séparation avec l'option
                                            '  précédente)
                C.Enabled = .Cells(L, 6)    ' Active ou désactive l'option à la création
        Next L
    End With
    Exit Sub
Erreur:
    MsgBox Err.Description & " (" & Err.Number & ") dans mcCréationMenus"
End Sub

Sub mcDésactiveMenus()
    ' Procédure (appelée par une option des menus contextuels) qui désactive
    ' l'usage des menus. Les menus contextuels standards d'Excel redeviennent actifs
    ' En réalité, c'est la procédure évènementièle Workbook_SheetBeforeRightClick
    ' qui va tester la variable globale mcMenusOuiNon pour savoir si elle intercepte de clic-droit
    ' ou si elle laisse faire Excel
    mcMenusOuiNon = False
End Sub
Sub mcActiveMenus()
    ' Appel de la procedure de création du menu contextuel
    ' Cette procédure est appelée par les touches : Ctrl-m
    ' (elle ne peut pas être appelée par une option de menu car ce dernier est désactivé)
    ' Elle recrée le système de menus et positionne l'indicateur d'activité à Vrai
    mcCreationMenus
    mcMenusOuiNon = True
End Sub

Sub mcAjouteOptionsCommun(NomMenu As String)
    ' Cette procédure permet d'ajouter à la fin de tous les menus
    ' les options du menu mcCommun
    ' Appelée par la procédure mcCréationMenus
    On Error GoTo Erreur
    ' Barre de menu mcCommun et ses controles
    Dim BSource As CommandBar
    Dim CSource As CommandBarControl
    Set BSource = Application.CommandBars(mcCommun)
    ' La barre de menu nouvellement créée à laquelle on veut ajouter
    ' les options de mcCommnun
    ' Son nom est fourni par la procédure appelante (ici mcCréationMenus)
    Dim BDest As CommandBar
    Dim CDest As CommandBarControl
    Set BDest = Application.CommandBars(NomMenu)
    ' Pour chaque contrôle de mcCommun
    ' on ajoute un contrôle à la nouvelle barre avec les mêmes propriétés
    For Each CSource In BSource.Controls
        Set CDest = BDest.Controls.Add          ' ajout du contrôle
        CDest.Caption = CSource.Caption         ' récupération du texte (légende)
        CDest.OnAction = CSource.OnAction       ' récupération de l'action associée
        CDest.BeginGroup = True                 ' Les options communes commencent toujours
                                                ' un nouveau groupe
        CDest.Tag = CSource.Tag                 ' récupération du Tag (identification interne)
    Next CSource
    Exit Sub
Erreur:
    MsgBox Err.Description & " (" & Err.Number & ") dans mcAjouteOptionsCommun"
End Sub

Sub mcAfficheMasqueFeuilleMenus()
    ' Cette procédure inverse la propriété de visibilité de la feuille Excel
    ' qui contient les éléments des menus
    With Sheets(mcNomFeuilleMenus)
        .Visible = Not .Visible
        ' après affichage, la feuille des menu est sélectionnée
        If .Visible Then .Select
    End With
End Sub

'===========================================================
' Dans ThisWorkbook
'===========================================================
Option Explicit

Private Sub Workbook_Open()
    mcActiveMenus
End Sub

' Lorsque l'utilisateur utilise le bouton droit de la souris
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    On Error GoTo Erreur
    Dim L As Integer
    Dim n As String
    ' Si Menu Contextuel non activé
    ' on sort de la procédure et
    ' le bouton droit de la souris garde son role habituel
    If Not mcMenusOuiNon Then Exit Sub
    ' si la feuille appelante figure dans la plage mcFeuilles
    ' on affiche le menu correspondant
    'sinon on affiche le menu mcStandard
    With Range(mcPlageFeuilles)
        n = mcStandard
        For L = 1 To .Rows.Count
            If .Cells(L, 1) = Sh.Name Then
                n = .Cells(L, 2)
                Exit For
            End If
        Next L
    End With
    Application.CommandBars(n).ShowPopup
    ' On annule l'affichage du menu contextuel par défaut
    Cancel = True
    Exit Sub
Erreur:
        MsgBox Err.Description & " (" & Err.Number & ") dans le BeforeRightClick"
End Sub

'============================================
' Dans un module : Quelques exemples d'accès aux menus
'============================================
Option Explicit

Function mcExemple()
    ' Quelques exemples d'accès aux contrôles des menus
    
    ' Pour déactiver le contrôle n du menu mcMachin
    Dim n As Integer
    CommandBars("mcMachin").Controls(n).Enabled = False
    
    ' Pour masquer le contrôle de Tag mcTruc dans le menu mcMachin
    CommandBars("mcMachin").FindControl(Tag:="mcTruc").Visible = False
    
    ' Pour désactiver tous les contrôles du menu mcMachin
    Dim C As CommandBarControl
    For Each C In CommandBars("mcMachin")
        C.Enabled = False
    Next C
    ' ou
    With CommandBars("mcMachin")
        For n = 1 To .Controls.Count
            .Controls(n).Enabled = False
        Next n
    End With
End Function

Ce code est fourni avec un exemple de classeur (MenuSimplifié.xls) qui utilise une version simplifiée avec un seul menu, un modèle de classeur(MenusContextuels.xlt) qui permet de créer de nouveaux classeurs avec le dispositif de menus prêt à l'emploi et un fichier texte qui contient le code (SourcesMenusContextuels.txt).

Le classeur obtenu par ce modèle ressemble aux classeurs vierges habituels (juste 3 feuilles vierges Feuil1, Feuil2 et Feuil3. Mais si vous utilisez le Clic-droit, vous voyez un menu contextuel particulier apparaitre. (Ce menu est d'ailleurs différent si on clique-droit sur la feuil1 ou sur les autres). La première chose à faire est sans doute d'afficher la feuille de menu.

Cette dernière est suffisamment commentée pour en comprendre le fonctionnement

Bon code
Jean

Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip

28 septembre 2007 15:36:01 :

Ajout de la gestion de plusieurs menus, affectation de menus à des feuilles, fourniture d'un modèle prêt à l'emploi

28 septembre 2007 15:37:28 :

Ajout de la gestion de plusieurs menus, affectation de menus à des feuilles, fourniture d'un modèle prêt à l'emploi

28 septembre 2007 15:45:08 :

Modification de la capture

28 septembre 2007 15:45:47 :

Modification de la capture

28 septembre 2007 15:47:46 :

Modification capture

• ENVOI AUTOMATIQUE DE MAIL (AVEC PIÈCE JOINTE) EN VBA : EXCEL, WORD OU ACCESS PAR OULOOK EXPRESS OU MODZILLA THUNDERBIRD OU D'AUTRES

• COMMENT DESSINER UN GRAPHE ORIENTE BY CHIHAOUI CAD UN GRAPHE QUI CONTIENT DES FLÈCHES ET NON PAS DES ARCS
• LISTE DES EMAILS, NUMÉRO DE TÉLÉPHONNES DES TRAVAILLEURS
• CALCUL DE MORTIER ET BETON
• GESTION DES BONS DE LIVRAISON
• GESTION DE STOCK

• RECHERCHER FICHIERS
• USERFORM ALWAYS ON TOP AVEC VBA SOUS EXCEL
• MENU CONTEXTUEL
• UTILISATION DE MYSQL AVEC EXCEL EN MODE SHELL, SANS DRIVER ODBC SOUS XP
• NOTIFYICON