[VBA]Menu contextuel dynamique dans un état

**marcb03** · 02/04/2007, 16h15

Bonjour,

A partir des exemples que j'ai pu trouvé sur ce site et que j'ai bien entendu tenté d'adapter à mon application, j'ai créé un menu contextuel dynamique pour des états affichés en mode apperçu avant impression.

Voici le code:

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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
 
Private Const MF_CHECKED = &H8&
Private Const MF_APPEND = &H100&
Private Const TPM_LEFTALIGN = &H0&
Private Const MF_DISABLED = &H2&
Private Const MF_GRAYED = &H1&
Private Const MF_SEPARATOR = &H800&
Private Const MF_STRING = &H0&
Private Const TPM_RETURNCMD = &H100&
Private Const TPM_RIGHTBUTTON = &H2&
 
Private Type POINTAPI
X As Long
Y As Long
End Type
 
Private Declare Function CreatePopupMenu Lib "user32" () As Long
 
Private Declare Function TrackPopupMenuEx Lib "user32" _
(ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, _
ByVal Y As Long, ByVal HWnd As Long, ByVal lptpm As Any) As Long
 
Private Declare Function GetSystemMenu Lib "user32" _
(ByVal HWnd As Long, ByVal bRevert As Long) As Long
 
Private Declare Function AppendMenu Lib "user32" Alias _
"AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, _
ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
 
Private Declare Function DestroyMenu Lib "user32" _
(ByVal hMenu As Long) As Long
 
Private Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long
 
Public Function MenuContextuel_Etat()
Dim Pt As POINTAPI
Dim result As Long
Dim hMenu As Long
Dim TypeMenu1 As Long
Dim TypeMenu2 As Long
Dim TypeMenu3 As Long
Dim TypeMenu4 As Long
Dim TypeMenu5 As Long
Dim TypeMenu6 As Long
Dim TypeMenu7 As Long
Dim TypeMenu8 As Long
Dim TypeMenu9 As Long
Dim TypeMenu10 As Long
Dim TypeMenu11 As Long
Dim TypeMenu12 As Long
TypeMenu1 = MF_STRING
TypeMenu2 = MF_STRING
TypeMenu3 = MF_STRING
TypeMenu4 = MF_STRING
TypeMenu5 = MF_STRING
TypeMenu6 = MF_STRING
TypeMenu7 = MF_STRING
TypeMenu8 = MF_STRING
TypeMenu9 = MF_STRING
TypeMenu10 = MF_STRING
TypeMenu11 = MF_STRING
TypeMenu12 = MF_STRING
hMenu = CreatePopupMenu()
AppendMenu hMenu, TypeMenu1, 1, "Zoom ajusté"
AppendMenu hMenu, TypeMenu2, 2, "Zoom à 10 %"
AppendMenu hMenu, TypeMenu3, 3, "Zoom à 25 %"
AppendMenu hMenu, TypeMenu4, 4, "Zoom à 50 %"
AppendMenu hMenu, TypeMenu5, 5, "Zoom à 75 %"
AppendMenu hMenu, TypeMenu6, 6, "Zoom à 100 %"
AppendMenu hMenu, TypeMenu7, 7, "Zoom à 150 %"
AppendMenu hMenu, TypeMenu8, 8, "Zoom à 200 %"
AppendMenu hMenu, MF_SEPARATOR, 9, ByVal 0&
AppendMenu hMenu, TypeMenu9, 10, "Imprimer"
AppendMenu hMenu, MF_SEPARATOR, 11, ByVal 0&
AppendMenu hMenu, TypeMenu10, 12, "Exporter dans Word"
AppendMenu hMenu, TypeMenu11, 13, "Exporter dans Exel"
AppendMenu hMenu, MF_SEPARATOR, 14, ByVal 0&
AppendMenu hMenu, TypeMenu12, 15, "Fermer"
GetCursorPos Pt
result = TrackPopupMenuEx(hMenu, _
TPM_LEFTALIGN Or TPM_RETURNCMD _
Or TPM_RIGHTBUTTON, Pt.X, Pt.Y, Screen.ActiveReport.HWnd, ByVal 0&)
DestroyMenu hMenu
Select Case result
Case 1
On Error GoTo Err
DoCmd.RunCommand acCmdFitToWindow
Case 2
On Error GoTo Err
DoCmd.RunCommand acCmdZoom10
Case 3
On Error GoTo Err
DoCmd.RunCommand acCmdZoom25
Case 4
On Error GoTo Err
DoCmd.RunCommand acCmdZoom50
Case 5
On Error GoTo Err
DoCmd.RunCommand acCmdZoom75
Case 6
On Error GoTo Err
DoCmd.RunCommand acCmdZoom100
Case 7
On Error GoTo Err
DoCmd.RunCommand acCmdZoom150
Case 8
On Error GoTo Err
DoCmd.RunCommand acCmdZoom200
Case 10
On Error GoTo Err
DoCmd.RunCommand acCmdPrint
Case 12
On Error GoTo Err
DoCmd.OutputTo acReport, Screen.ActiveReport.Name, "RichTextFormat(*.rtf)", , True, ""
Case 13
On Error GoTo Err
DoCmd.OutputTo acReport, Screen.ActiveReport.Name, "MicrosoftExcel(*.xls)", , True, ""
Case 15
On Error GoTo Err
DoCmd.Close acReport, Screen.ActiveReport.Name, acSaveYes
Err: FormattedMsgBox "Cette commande est indisponible!@Contactez le support technique de cette application.@", vbCritical, ApplicationNameApi()
End Select
End Function

Le problème est que lorsque je sélectionne l'une des commandes de ce menu, j'ai l'apparition à l'endroit du curseur d'un petit carré (1cm x 1cm) sans aucun bouton ni texte, que je ne peux pas déplacer, et que je peux juste fermer en cliquant ailleurs sur l'aperçu de mon état.

Par ailleurs, sur les cases 12, 13 et 15 (Word, Exel et Fermer), j'ai une erreur dont j'ai obtenu l'identifiant en supprimant la ligne On Error GoTo Err : Erreur d'exécution 2585 - Impossible d'exécuter cette action pendant le traitement d'un évènement d'un ... état.

J'ai l'impressio qu'il s'agit d'un problème de fermeture du menu contextuel, mais je n'en suis pas sûr.

Quelqu'un peut-il me dire ce qu'il manque à ce code ?

Merci d'avance.

**marcb03** · 02/04/2007, 17h30

Personne n'a une idée.
Le sujet me semble pourtant intéressant ...

Merci

**FreeAccess** · 02/04/2007, 21h31

Bonsoir,
Pour l'instant ....pas de réponse.....mais avant il serait bien que tu mettes tout ton code VBA entre les balises #.......

Ré-édite ton post et corrige tout ça....

Dans ton code, as-tu essayé de supprimer tous tes contrôles d'erreur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

On Error GoTo Err

**marcb03** · 02/04/2007, 21h36

Bonjour,

Excuses-moi, mais je débute vraiment en code et j'essaye de comprendre.
C'est quoi tes balises ?

Pour répondre à ta question, j'ai effectivement essayé de supprimer On Error GoTo Err

Envoyé par marcb03

Par ailleurs, sur les cases 12, 13 et 15 (Word, Exel et Fermer), j'ai une erreur dont j'ai obtenu l'identifiant en supprimant la ligne On Error GoTo Err : Erreur d'exécution 2585 - Impossible d'exécuter cette action pendant le traitement d'un évènement d'un ... état.

**FreeAccess** · 02/04/2007, 22h41

Re,
Tout d'abord, pourquoi avoir changer une partie du code.....

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
result = TrackPopupMenuEx(hMenu, _
TPM_LEFTALIGN Or TPM_RETURNCMD _
Or TPM_RIGHTBUTTON, Pt.X, Pt.Y, Screen.ActiveReport.HWnd, ByVal 0&)

Ensuite as-tu essayé de faire un menu contextuel ordinaire (non dynamique) et de le déclarer dans la propriété "Barre de menus contextuel" de ton état....

Sinon fait une simple barre d'outils personnels sur ton etat...c'est aussi rapide et autant convivial...et en plus pratiquement pas de code VBA...

**marcb03** · 03/04/2007, 08h39

Bonjour,

Envoyé par FreeAccess

Re,
Tout d'abord, pourquoi avoir changer une partie du code.....

Tous simplement parceque cela ne fonctionnait pas, cad que mon menu contextuel ne disparaissait pas si je cliquais à un autre endroit de mon aperçu.
De plus, j'avais une erreur et ouverture de la fenêtre de débogage.

Envoyé par FreeAccess

Ensuite as-tu essayé de faire un menu contextuel ordinaire (non dynamique) et de le déclarer dans la propriété "Barre de menus contextuel" de ton état....

Sinon fait une simple barre d'outils personnels sur ton etat...c'est aussi rapide et autant convivial...et en plus pratiquement pas de code VBA...

Oui bien sûr, sauf que je voulais éviter d'avoir à refaire cette barre de menu contextuel pour chacune de mes 15 applications ... et encore moins une barre d'outils à chaque état de mes applications.
De plus, j'ai monté un menu contextuel dynamique pour les formulaires qui permet d'activer ou désactiver certaines commandes en fonction des données et des utilisateurs. Je voulais rester dans la même logique et avoir quelque chôse de centralisé plus pratique en maintenance.

@+

**FreeAccess** · 03/04/2007, 19h01

Bonjour,

Oui bien sûr, sauf que je voulais éviter d'avoir à refaire cette barre de menu contextuel pour chacune de mes 15 applications ...

Sauf erreur de ma part, mais tu n'es pas obligé de tout refaire pour une nouvelle application...il suffit d'importer tes barres de menus / outils dans cette application....

**marcb03** · 04/04/2007, 08h46

Effectivement,

J'ai cherché dans l'aide et cela semble possible.

Mais je préférerais largement rester sur un menu contextuel dynamique - peut-être plus difficile à mettre en oeuvre - mais plus souple et qui constitue une solution très intéressante à partir du moment ou j'aurai bouclé le code nécessaire.

Pour revenir à mon problème, j'ai la totale conviction que le petit carré de 1cm de côté qui apparaît lorsque je clique sur une commande du menu contextuel dynamique est la cause de l'erreur.

Manifestement, ce forum permet de mettre en commun des compétences très pointues en Access et en VB. S'il était possible que mon pb attire l'attention, je pense que nous pourrions avancer.

PS: Je vois que qqu'un à remis en forme le code de mon premier message.
Merci et désolé car je ne savais pas pour les balises. Je ne demande qu'à apprendre.

[VBA]Menu contextuel dynamique dans un état

VBA Access

Vue hybride

Discussions similaires

Partager

Partager