A propos de .accde et de menus contextuels

Question

Bonjour à toutes et tous,
j'ai conçu une application Access que j'ai compilé et compacté sans aucune erreur ! pour tester cette appli, je l'ai copié et renommé GED.ACCDR. A l'utilisation, toujours aucune erreur. Dans cette appli, j'ai conçu des menus contextuels (voir ci-dessous) Je voudrais que cette appli sois enregistrée en GED.ACCDE. Et là est le problème : les menus contextuels ( il y en a 5 !) ne s'exécutent pas ! Je cherche à savoir pourquoi et comment y remédier.
Merci pour votre aide,

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = acRightButton Then  
    Dim cb As CommandBar  
    Dim cbc As CommandBarControl  
      
    ' \*\*\* Supprimer un menu existant s'il y en a un  
    On Error Resume Next  
    CommandBars("MenuArmoires").Delete  
    On Error GoTo 0  

    ' \*\*\* Créer un nouveau menu contextuel  
    Set cb = CommandBars.Add(Name:="MenuArmoires", Position:=msoBarPopup, Temporary:=True)  
      
    ' \*\*\* Ajouter l'option 1 au menu contextuel  
    Set cbc = cb.Controls.Add(Type:=msoControlButton)  
    cbc.Caption = "Ajouter une armoire"  
    cbc.OnAction = "=AjouterArmoire()"  
      
    ' \*\*\* Ajouter l'option 2 au menu contextuel  
    Set cbc = cb.Controls.Add(Type:=msoControlButton)  
    cbc.Caption = "Ouvrir l'armoire"  
    cbc.OnAction = "=OuvrirArmoire()"  

    ' \*\*\* Ajouter l'option 3 au menu contextuel  
    Set cbc = cb.Controls.Add(Type:=msoControlButton)  
    cbc.Caption = "Supprimer l'armoire"  
    cbc.OnAction = "=SupprimerArmoire()"  
      
    ' \*\*\* Afficher le menu contextuel  
    On Error Resume Next  
    cb.ShowPopup  
    On Error GoTo 0  
      
    ' \*\*\* Libérer la mémoire  
    Set cb = Nothing  
    Set cbc = Nothing  
End If  
  

End Sub

Answer 1

Cette réponse a été automatiquement traduite. Par conséquent, il peut y avoir des erreurs grammaticales ou des formulations étranges.

Salut Minimir09,

Vous devez activer la propriété ShortcutMenu et définir la propriété ShortcutMenuBar de votre formulaire sur le nom de la barre de commande « MenuArmoires ». Le code VBA amélioré suivant a fonctionné pour moi dans les fichiers ACCDE et ACCDB :

Dim cb As CommandBar
Dim cbc As CommandBarControl

Private Sub Form_Load()
    ' *** Supprimer un menu existant s'il y en a un
    On Error Resume Next
    CommandBars("MenuArmoires").Delete
    On Error GoTo 0
    
    Const MENU_NAME As String = "MenuArmoires"
    
    ' *** Créer un nouveau menu contextuel
    Set cb = CommandBars.Add(Name:=MENU_NAME, Position:=msoBarPopup, Temporary:=True)
    
    ' *** Ajouter l'option 1 au menu contextuel
    Set cbc = cb.Controls.Add(Type:=msoControlButton)
    cbc.Caption = "Ajouter une armoire"
    cbc.OnAction = "=AjouterArmoire()"
    
    ' *** Ajouter l'option 2 au menu contextuel
    Set cbc = cb.Controls.Add(Type:=msoControlButton)
    cbc.Caption = "Ouvrir l'armoire"
    cbc.OnAction = "=OuvrirArmoire()"

    ' *** Ajouter l'option 3 au menu contextuel
    Set cbc = cb.Controls.Add(Type:=msoControlButton)
    cbc.Caption = "Supprimer l'armoire"
    cbc.OnAction = "=SupprimerArmoire()"
    
    Me.ShortcutMenu = True
    Me.ShortcutMenuBar = MENU_NAME
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = acRightButton Then
        ' *** Afficher le menu contextuel
        On Error Resume Next
        
        cb.ShowPopup
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set cbc = Nothing
    Set cb = Nothing
End Sub

Voir les captures d’écran :

1. Fichier ACCDB :

2. Fichier ACCDE :

Enfin, n’oubliez pas d’ajouter la bibliothèque d’objets Microsoft Office xx.0 dans votre projet 🙂 VBA :