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 messageCette erreur correspond en fait à une erreur 440.Erreur d'exectution '-2147467259 (80004005)' La méthode ShowPopup de l'objet CommandBar a échoué
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 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 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
J'ai laissé le code essayé qui ne marche pas non plus.
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
Merci d'avance
Bruno
Partager