Bonjour

Je voudrais supprimer toutes les barres d'outils Access ainsi que le menu Fichier, et afficher dans mon form principal mon propre menu.
J'ai fouiné un peu partout, et j'ai trouvé des choses (désolé, mais je ne sais plus où), le code ci après.

Mon problème : Affichage du message
Erreur d'exectution '-2147467259 (80004005)' La méthode ShowPopup de l'objet CommandBar a échoué
Cette erreur correspond en fait à une erreur 440.
Je n'ai pas réussi à corriger ce problème (bien évidement, j'ai bien créé ma propre barre d'outils et en ai vérifié le nom).

Code dans un module

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
 
Option Compare Database
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'Permet l'affichage des menus Fichier, édition... crées
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Public Type POINTAPI
    x As Long
    y As Long
End Type
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Code dans mon formulaire

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 
Private Sub lblFichier_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
 
'Permet l'ouverture / fermeture du menu
    Dim pt As POINTAPI
    Dim NbPointParPouceX As Long, NbPointParPouceY As Long
    'récupère la position de la souris
    GetCursorPos pt
    'Récupère le nombre de pixel par pouce
    NbPointParPouceX = GetDeviceCaps(GetDC(0), 88)
    NbPointParPouceY = GetDeviceCaps(GetDC(0), 90)
    'Affiche la barre de menu à l'endroit souhaité
    CommandBars("MenuFichier").ShowPopup pt.x - (x / (1440 / NbPointParPouceX)), pt.y + (lblFichier.Height - y) / (1440 / NbPointParPouceY)
 
'                Dim cbr As CommandBar
'                    On Error Resume Next
'                Set cbr = CommandBars("MenuFichier")
'                If Err = 0 Then
'                    With cbr
'                       ' MsgBox "La barre de commandes nommée '" & .Name & "' contient " & _
'                            .Controls.Count & IIf(.Controls.Count = 1, " contrôle et ", _
'                            " contrôle et ") & IIf(.BuiltIn, "est", "n'est pas") & _
'                            " une barre d'outils par défaut", vbOKOnly, "'" & _
'                            .Name & "' Information:"
'                        cbr.ShowPopup 'pt.X - (X / (1440 / NbPointParPouceX)), pt.Y + (lblFichier.Height - Y) / (1440 / NbPointParPouceY)
'                   ' MsgBox "La barre de commandes nommée " & .Name
'                    End With
'                Else
'                    MsgBox "La barre de commandes n'existe pas"
'                End If
 
End Sub
J'ai laissé le code essayé qui ne marche pas non plus.

Merci d'avance

Bruno