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)
Source / Exemple :
'==============================================
' 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
Conclusion :
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
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.