Discussion :

[petitbison]

Bonjour,
Voila la Situation :
Je travaille sur ACCESS 2003.
J’inclus manuellement le fichier MSO.DLL ; pour mon PC, il se trouve dans C:\Program Files\Fichiers communs\Microsoft Shared\OFFICE11
Je crée un menu dynamique à partir d’un recordset basé sur une table.
Les menus, sous menu et boutons s’affichent selon la logique que j’ai établi.

Voila les problèmes :
1) J’éteint mon poste, je redémarre et les boutons (msoControlButton) du menu n’apparaissent plus. Je ré inclus le fichier MSO.DLL et rien ne marche plus !!!!!!!.
2) je crée une nouvelle BD, j’y importe le module et la table en question, je ré inclus le fichier MSO.DLL et ça marche !!!!!!!.
3) Les menus apparaissent relativement lentement, y’a t il moyen d’accélérer cette opération ?
4) je n’arrive pas à contrôler la propriété Enabled selon l’item de la Combo.
5) je n’arrive pas à afficher les TooltipText, pourtant, son texte est bien transmis à la procédure.
6) la fonction FindControl n’accepte pas le paramètre Recursive

Le fichier ci-joint contient la table et le code, si cela peut apporter quelque chose à quelqu’un.
C’est beaucoup tout cela, non ???.

Merci.

En tout cas, voici l’affreux 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
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
'#################################################
'#################################################
Public Sub MenuPerformanceSport() 'Procédure principale de création du menu
Dim rstMenu As DAO.Recordset
Dim strSQLMenu As String
Dim strTag As String
Dim strTagParent As String
Dim strNomCommandBar As String
Dim strNomEntete As String
Dim strCaption As String
Dim objCommandBar As Office.CommandBar
Dim objCommandBarComboBox As Office.CommandBarComboBox
Dim strGenre As String
Dim lMonRepère As Long
Dim lFaceId As Long
Dim strInfoBull As String
Dim strSpecific As String
 
strNomCommandBar = "MenuSports"
Call SuppMenu(strNomCommandBar)
Set objCommandBar = Application.CommandBars.Add(strNomCommandBar, , True)
objCommandBar.Visible = True
 
strSQLMenu = "Select *   From tMenu  ORDER BY MonRepère "
Set rstMenu = CurrentDb.OpenRecordset(strSQLMenu, dbOpenDynaset)
rstMenu.MoveFirst
While Not rstMenu.EOF
    strInfoBull = CStr(Nz(rstMenu("InfoBull"), "Vide"))
    strSpecific = CStr(Nz(rstMenu("Spécifique"), "Non"))
    lFaceId = CLng(IIf(Not IsNull(rstMenu("IconBtn")), rstMenu("IconBtn"), 0))
    strGenre = CStr(IIf(Not IsNull(rstMenu("Action")), "Btn", "Pop"))
    strTag = rstMenu("MenuID")
    strCaption = rstMenu("Nom")
    Select Case rstMenu("Parent")
    Case "Top"
        strNomEntete = rstMenu("Nom")
        'Appeler création entete menu
        Call AjoutEnteteMenuPerfSport(strNomCommandBar, strNomEntete, strTag)
    Case Else
        'c'est un sous menu
        strTagParent = rstMenu("Parent")
        Call AjoutSousMenuPerfSport(strTag, strCaption, strTagParent, strGenre, lFaceId, strInfoBull, strSpecific)
    End Select
 
    rstMenu.MoveNext
Wend
' Ajouter en fin de menu la combo pour Objectif ou Réalisation
Set objCommandBarComboBox = objCommandBar.Controls.Add(msoControlComboBox)
With objCommandBarComboBox
    .AddItem "Réalisation"
    .AddItem "Objectif"
    '.Text = "Catégorie"
    .Style = msoComboNormal
    .TooltipText = "Sélectionner la catégorie des Données et des Résultats"
    .ListIndex = 1 'ie Réalisation par défaut
    .OnAction = "Estomper"
 
End With
rstMenu.Close
Set rstMenu = Nothing
End Sub
'#################################################
'#################################################
Public Sub AjoutEnteteMenuPerfSport(strNomCommandBar As String, strNomEntete As String, strTag As String)
 
Dim objCommandBarControl As Office.CommandBarControl
Dim objCommandBarPopup As Office.CommandBarPopup
 
    Set objCommandBarPopup = Application.CommandBars(strNomCommandBar).Controls.Add(msoControlPopup)
    With objCommandBarPopup
        .Caption = strNomEntete
        '.Style = msoButtonCaption
        .Tag = strTag
    End With
'#################################################
'#################################################
Public Sub AjoutSousMenuPerfSport(strTag As String, strCaption As String, strTagParent As String, strGenre As String, lFaceId As Long, strInfoBull As String, strSpecific As String)
On Error GoTo List_Err
 
Dim objCommandBarControl As Office.CommandBarControl
 
Dim objCommandBarPopup As Office.CommandBarPopup
Dim objCommandBarPopup2 As Office.CommandBarPopup
 
Set objCommandBarPopup = Application.CommandBars.FindControl(msoControlPopup, , Tag:=strTagParent) ', Visible:=False, Recursive:=True)
Select Case strGenre
Case "Pop"
    Set objCommandBarPopup2 = objCommandBarPopup.Controls.Add(msoControlPopup)
    objCommandBarPopup2.Caption = strCaption
    objCommandBarPopup2.Tag = strTag
Case "Btn"
    Set objCommandBarControl = objCommandBarPopup.Controls.Add(msoControlButton)
    objCommandBarControl.Style = msoButtonIconAndCaption
    objCommandBarControl.Caption = strCaption
    objCommandBarControl.Tag = strTag
    objCommandBarControl.FaceId = lFaceId
    If strInfoBull <> "Vide" Then objCommandBarControl.TooltipText = strInfoBull
    'La TooltipText ne fonctionne pas ?????
    objCommandBarControl.Parameter = strSpecific
    objCommandBarControl.OnAction = "=ActionBtnMenu (" & Chr(34) & strTag & Chr(34) & ")"
    objCommandBarControl.Visible = True
End Select
ListBouton_Fin:
    Exit Sub
 
List_Err:
        MsgBox "Erreur " & Err.Number & ": " & Err.Description
 
Resume ListBouton_Fin
 
 
End Sub
'#################################################
'#################################################
Public Function ActionBtnMenu(strTag As String)
Select Case strTag
Case "A4", "C100", "I3", "H4", "E6", "F6", "D4", "B4", "G8"
    MsgBox "Quitter application"
Case Else
    MsgBox "Faire autre chose avec le bouton :   " & strTag
End Select
 
End Function
'#################################################
'#################################################
 
Public Sub Estomper()
Dim objCommandBar As Office.CommandBar
Dim btn As Office.CommandBarControl
Dim btnCombo As CommandBarComboBox
Dim strCatComboBox As String
 
Dim strCat As String
Dim strNomCommandBar As String
strNomCommandBar = "MenuSports"
Set btnCombo = CommandBars("MenuSports").FindControl(msoControlComboBox)
strCatComboBox = btnCombo.List(btnCombo.ListIndex)
Select Case strCatComboBox
Case "Objectif"
    For Each btn In Application.CommandBars.Item("MenuSports").Controls
        If btn.Type = msoControlButton Then
            If btn.Parameter = "O" Then btn.Enabled = True
            If btn.Parameter = "R" Then btn.Enabled = False
        End If
    Next btn
 
Case "Réalisation"
    For Each btn In CommandBars("MenuSports").Controls
        If btn.Type = msoControlButton Then
            If btn.Parameter = "O" Then btn.Enabled = False
            If btn.Parameter = "R" Then btn.Enabled = True
        End If
    Next btn
End Select
End Sub
'#################################################
'#################################################
 
Private Sub Quitter()
    'DoCmd.Quit
    MsgBox "Quitter application"
End Sub
'#################################################
'#################################################
 
Public Sub SuppMenu(strNomCommandBar As String)
Dim objCommandBar As Office.CommandBar
For Each objCommandBar In Application.CommandBars
    If objCommandBar.Name = strNomCommandBar Then
        objCommandBar.Delete
    End If
Next objCommandBar
 
End Sub

[faressam]

En respectant tous ce que tu as écris, je dirai que si j'étais à ta place, et si ce n'est déjç fait, il faut commencer par la solution la plus évidente sans se creuser et perdre du temps dans le Code, Désinstalle et réinstalles ton Access 2003, si tu n'as pas de clés en main, prends une version d'évaluation du site de microsoft, rien que pour voir si réellement ça vient de toi ou du Code (une solution N°1 avant de désinstaller).

Personnellement moi aussi mon Access 2003 et parfois très lent à afficher mes tables dans la base de donnée, ou même d'affichier le menu contextuelle boutton droit sur un menu boutton ou n'importe, puis parfois aussi ça marche normalement.

[petitbison]

Bonjour;
j'ai désinstallé tout office 2003, puis j'ai refais l'installation de nouveau.
Résultat: toujours le même problème. ie, les boutons de mon menu n'apparaisent pas.
Conclusion:le problème provient du code ou alors il manque un truc à mon access 2003.
Merci pour ton aide.
Vraiment, je souhaite résoudre rapidement ce problème.
Est ce que je suis dans le bon forum ?

PS: Je ne suis pas étudiant. Je suis self made.

salut à tout le monde.

[faressam]

Je pense que si tu es sur le bon Forum,

je te suggéres dans ton Cas, d'installer pas ta version mais une version d'essai sur le Web (site Microsoft), ou même de prendre ton application et de l'ouvrir avec un Access 2003 sur une autre MAchine, Sinon aussi mettre une autre version Access 97 ou 2007 etc ... et tu vois le résultat.

Nb : même si on est étudiant, mais crois moi l'ami, on est souvent en mode self, car tu étudies ce que tu dois faire sous VBA mais pas forcement du VBA, en informatique on est tous les jours débutant et il faut se mettre à Niveau.Bon courage en espérant que ça marchera chez toi.

[petitbison]

Bonjour;
Effectivement, après installation sur office 2007, Le menu a fonctionné correctement. l'utilisation de office 2003 étant imposée, j'ai résolu le problème en créant une fonction qui me retourne un tableau contenant les parents des contrôles du menu.

C'est la findcontrole qui ne "finde" pas au delà d'une génération, et le machin recursive qui veut pas aller droit.
En tout cas, je vous remercie de votre aide et de votre soutien et au prochain quic.
Salut.