Problème sur la création de menu (menumakr)

**Poussecafe** · 26/11/2013, 12h08

Bonjour à tous et d'avance merci pour votre aide.

Je viens vous soumettre mon code car je n'arrive pas à m'en sortir.
J'ai récupéré l'exemple de création de menu en VBA de John Walkenbach (et j'en profite pour le remercier) sur le net et j'ai essayé de l'adapter de façon à ce qu'il démarre à l'ouverture d'Excel (AUTO_OPEN) et de façon à augmenter le nombre de menus et de sous-menus.
Le principe de ce développement est simple :
A l'ouverture d'Excel, une feuille est créée automatiquement avec la description du menu et est fermée quand le menu est créé.
Ceci fonctionne parfaitement.

Ce qui ne fonctionne pas est le positionnement des différents menus et sous-menus.

Voila ce que j'essaye d'obtenir (et voire même par la suite, pouvoir encore rajouter un autre sous-niveau):

MENU GENERAL
.....Menu 1
...........Menu 11
................Menu 111
................Menu 112
................Menu 113
................Menu 114
...........Menu 12
................Menu 121
...........Menu 13
................Menu 131
................Menu 132
................Menu 133
................Menu 134
................Menu 135
............Menu 2
............Menu 3
................Menu 31
............Menu 4
................Menu 41
................Menu 42
............Menu 5
................Menu 51
................Menu 52

Et voila ce que j'obtiens :

MENU GENERAL
.......Menu 1
.......Menu 11
............Menu 111
............Menu 112
............Menu 113
............Menu 114
.......Menu 12
............Menu 121
.......Menu 13
............Menu 131
............Menu 132
............Menu 133
............Menu 134
............Menu 135
.......Menu 2
.......Menu 3
............Menu 31
.......Menu 4
............Menu 41
............Menu 42
.......Menu 5
............Menu 51
............Menu 52

Voila déjà plusieurs fois que je mets le nez dans les lignes de code, et je n'arrive plus à voir où est mon erreur, donc je fais appel à vous tous. Je suppose qu'il s'agit d'un rien du tout, mais comme mes maîtres informaticiens me le conseillaient : "lorsque tu ne vois plus rien, appelle à l'aide". C'est ce que je fais.

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
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
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
Sub creation_menu()
'       Définition d'une table comportant les paramètres des choix
Dim W_Table_Menu_Level(1 To 30) As Variant
Dim W_Table_Menu_Caption(1 To 30) As Variant
Dim W_Table_Menu_PositionouMacro(1 To 30) As Variant
Dim W_Table_Menu_Divider(1 To 30) As Variant
Dim W_Table_Menu_FaceID(1 To 30) As Variant
'
Dim W_I As Integer
Dim W_J As Integer
 
W_I = 1
W_Table_Menu_Caption(W_I) = "MENU GENERAL"
W_Table_Menu_Level(W_I) = "1"
W_Table_Menu_PositionouMacro(W_I) = "10"
W_Table_Menu_Divider(W_I) = ""
W_Table_Menu_FaceID(W_I) = ""
'
W_I = W_I + 1
W_Table_Menu_Caption(W_I) = "Menu 1"
W_Table_Menu_Level(W_I) = "2"
W_Table_Menu_PositionouMacro(W_I) = ""
W_Table_Menu_Divider(W_I) = ""
W_Table_Menu_FaceID(W_I) = ""
'
W_I = W_I + 1
W_Table_Menu_Caption(W_I) = "Menu 11"
W_Table_Menu_Level(W_I) = "3"
W_Table_Menu_PositionouMacro(W_I) = ""
W_Table_Menu_Divider(W_I) = ""
W_Table_Menu_FaceID(W_I) = ""
'
W_I = W_I + 1
W_Table_Menu_Caption(W_I) = "Menu 111"
W_Table_Menu_Level(W_I) = "4"
W_Table_Menu_PositionouMacro(W_I) = "DummyMacro"
W_Table_Menu_Divider(W_I) = ""
W_Table_Menu_FaceID(W_I) = "138"
'
W_I = W_I + 1
W_Table_Menu_Caption(W_I) = "Menu 112"
W_Table_Menu_Level(W_I) = "4"
W_Table_Menu_PositionouMacro(W_I) = "DummyMacro"
W_Table_Menu_Divider(W_I) = ""
W_Table_Menu_FaceID(W_I) = "47"
'
W_I = W_I + 1
W_Table_Menu_Caption(W_I) = "Menu 113"
W_Table_Menu_Level(W_I) = "4"
W_Table_Menu_PositionouMacro(W_I) = "DummyMacro"
W_Table_Menu_Divider(W_I) = ""
W_Table_Menu_FaceID(W_I) = "160"
'
W_I = W_I + 1
W_Table_Menu_Caption(W_I) = "Menu 114"
W_Table_Menu_Level(W_I) = "4"
W_Table_Menu_PositionouMacro(W_I) = "DummyMacro"
W_Table_Menu_Divider(W_I) = "VRAI"
W_Table_Menu_FaceID(W_I) = ""
'
W_I = W_I + 1
W_Table_Menu_Caption(W_I) = "Menu 12"
W_Table_Menu_Level(W_I) = "3"
W_Table_Menu_PositionouMacro(W_I) = "DummyMacro"
W_Table_Menu_Divider(W_I) = ""
W_Table_Menu_FaceID(W_I) = ""
'
W_I = W_I + 1
W_Table_Menu_Caption(W_I) = "Menu 121"
W_Table_Menu_Level(W_I) = "4"
W_Table_Menu_PositionouMacro(W_I) = "DummyMacro"
W_Table_Menu_Divider(W_I) = ""
W_Table_Menu_FaceID(W_I) = ""
'
W_I = W_I + 1
W_Table_Menu_Caption(W_I) = "Menu 13"
W_Table_Menu_Level(W_I) = "3"
W_Table_Menu_PositionouMacro(W_I) = "DummyMacro"
W_Table_Menu_Divider(W_I) = "VRAI"
W_Table_Menu_FaceID(W_I) = ""
'
W_I = W_I + 1
W_Table_Menu_Caption(W_I) = "Menu 131"
W_Table_Menu_Level(W_I) = "4"
W_Table_Menu_PositionouMacro(W_I) = "DummyMacro"
W_Table_Menu_Divider(W_I) = ""
W_Table_Menu_FaceID(W_I) = ""
'
W_I = W_I + 1
W_Table_Menu_Caption(W_I) = "Menu 132"
W_Table_Menu_Level(W_I) = "4"
W_Table_Menu_PositionouMacro(W_I) = "DummyMacro"
W_Table_Menu_Divider(W_I) = ""
W_Table_Menu_FaceID(W_I) = ""
'
W_I = W_I + 1
W_Table_Menu_Caption(W_I) = "Menu 133"
W_Table_Menu_Level(W_I) = "4"
W_Table_Menu_PositionouMacro(W_I) = "DummyMacro"
W_Table_Menu_Divider(W_I) = ""
W_Table_Menu_FaceID(W_I) = ""
'
W_I = W_I + 1
W_Table_Menu_Caption(W_I) = "Menu 134"
W_Table_Menu_Level(W_I) = "4"
W_Table_Menu_PositionouMacro(W_I) = "DummyMacro"
W_Table_Menu_Divider(W_I) = ""
W_Table_Menu_FaceID(W_I) = ""
'
W_I = W_I + 1
W_Table_Menu_Caption(W_I) = "Menu 135"
W_Table_Menu_Level(W_I) = "4"
W_Table_Menu_PositionouMacro(W_I) = "DummyMacro"
W_Table_Menu_Divider(W_I) = ""
W_Table_Menu_FaceID(W_I) = ""
'
W_I = W_I + 1
W_Table_Menu_Caption(W_I) = "Menu 2"
W_Table_Menu_Level(W_I) = "2"
W_Table_Menu_PositionouMacro(W_I) = "DummyMacro"
W_Table_Menu_Divider(W_I) = ""
W_Table_Menu_FaceID(W_I) = ""
'
W_I = W_I + 1
W_Table_Menu_Caption(W_I) = "Menu 3"
W_Table_Menu_Level(W_I) = "2"
W_Table_Menu_PositionouMacro(W_I) = "DummyMacro"
W_Table_Menu_Divider(W_I) = "VRAI"
W_Table_Menu_FaceID(W_I) = ""
'
W_I = W_I + 1
W_Table_Menu_Caption(W_I) = "Menu 31"
W_Table_Menu_Level(W_I) = "3"
W_Table_Menu_PositionouMacro(W_I) = "DummyMacro"
W_Table_Menu_Divider(W_I) = ""
W_Table_Menu_FaceID(W_I) = ""
'
W_I = W_I + 1
W_Table_Menu_Caption(W_I) = "Menu 4"
W_Table_Menu_Level(W_I) = "2"
W_Table_Menu_PositionouMacro(W_I) = ""
W_Table_Menu_Divider(W_I) = "VRAI"
W_Table_Menu_FaceID(W_I) = ""
'
W_I = W_I + 1
W_Table_Menu_Caption(W_I) = "Menu 41"
W_Table_Menu_Level(W_I) = "3"
W_Table_Menu_PositionouMacro(W_I) = "DummyMacro"
W_Table_Menu_Divider(W_I) = ""
W_Table_Menu_FaceID(W_I) = ""
'
W_I = W_I + 1
W_Table_Menu_Caption(W_I) = "Menu 42"
W_Table_Menu_Level(W_I) = "3"
W_Table_Menu_PositionouMacro(W_I) = "DummyMacro"
W_Table_Menu_Divider(W_I) = ""
W_Table_Menu_FaceID(W_I) = ""
'
W_I = W_I + 1
W_Table_Menu_Caption(W_I) = "Menu 5"
W_Table_Menu_Level(W_I) = "2"
W_Table_Menu_PositionouMacro(W_I) = ""
W_Table_Menu_Divider(W_I) = "VRAI"
W_Table_Menu_FaceID(W_I) = ""
'
W_I = W_I + 1
W_Table_Menu_Caption(W_I) = "Menu 51"
W_Table_Menu_Level(W_I) = "3"
W_Table_Menu_PositionouMacro(W_I) = "DummyMacro"
W_Table_Menu_Divider(W_I) = ""
W_Table_Menu_FaceID(W_I) = ""
'
W_I = W_I + 1
W_Table_Menu_Caption(W_I) = "Menu 52"
W_Table_Menu_Level(W_I) = "3"
W_Table_Menu_PositionouMacro(W_I) = "DummyMacro"
W_Table_Menu_Divider(W_I) = "VRAI"
W_Table_Menu_FaceID(W_I) = ""
'
If W_I <= 30 Then
    W_I = W_I + 1
    W_Table_Menu_Caption(W_I) = ""
    W_Table_Menu_Level(W_I) = ""
    W_Table_Menu_PositionouMacro(W_I) = ""
    W_Table_Menu_Divider(W_I) = ""
    W_Table_Menu_FaceID(W_I) = ""
End If
'
'
'           Nom de la feuille
    Workbooks.Add
    Sheets(1).Select
    Sheets(1).Name = "MenuSheet"
    Sheets("MenuSheet").Select
'           Création des entêtes du tableau servant à créer le menu
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Level"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Caption"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Position/Macro"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Divider"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "FaceID"
'
'           Remplissage des cellules
'
    W_J = 1
    For W_I = 1 To 30
        W_J = W_J + 1
        Range("A" & W_J).Select
        Range("A" & W_J).Value = W_Table_Menu_Level(W_I)
        Range("B" & W_J).Select
        Range("B" & W_J).Value = W_Table_Menu_Caption(W_I)
        Range("C" & W_J).Select
        Range("C" & W_J).Value = W_Table_Menu_PositionouMacro(W_I)
        Range("D" & W_J).Select
        Range("D" & W_J).Value = W_Table_Menu_Divider(W_I)
        Range("E" & W_J).Select
        Range("E" & W_J).Value = W_Table_Menu_FaceID(W_I)
    Next
'
'           Mise en forme des entêtes de colonnes et des colonnes
    Range("A1:E1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Columns("A:E").Select
    Selection.Columns.AutoFit
'
'                    Création du menu
'
'   This sub should be executed when the workbook is opened.
'   NOTE: There is no error handling in this subroutine
 
    Dim MenuSheet As Worksheet
    Dim MenuObject As CommandBarPopup
 
    Dim MenuItem As Object
    Dim SubMenuItem As CommandBarButton
    Dim Row As Integer
    Dim MenuLevel, NextLevel, PositionOrMacro, Caption, Divider, FaceId
 
''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Location for menu data
    Set MenuSheet = Sheets("MenuSheet")
''''''''''''''''''''''''''''''''''''''''''''''''''''
 
'   Make sure the menus aren't duplicated
    Call DeleteMenu
 
'   Initialize the row counter
    Row = 2
 
'   Add the menus, menu items and submenu items using
'   data stored on MenuSheet
 
    Do Until IsEmpty(MenuSheet.Cells(Row, 1))
        With MenuSheet
            MenuLevel = .Cells(Row, 1)
            Caption = .Cells(Row, 2)
            PositionOrMacro = .Cells(Row, 3)
            Divider = .Cells(Row, 4)
            FaceId = .Cells(Row, 5)
            NextLevel = .Cells(Row + 1, 1)
        End With
'
        Select Case MenuLevel
'
           Case 1 ' A Menu
'              Add the top-level menu to the Worksheet CommandBar
                Set MenuObject = Application.CommandBars(1). _
                    Controls.Add(Type:=msoControlPopup, _
                    Before:=PositionOrMacro, _
                    Temporary:=True)
                MenuObject.Caption = Caption
 
            Case 2 ' A Menu Item
               If NextLevel = 3 Or 4 Then
                   Set MenuItem = MenuObject.Controls.Add(Type:=msoControlPopup)
               Else
                   Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
                   MenuItem.OnAction = PositionOrMacro
               End If
               MenuItem.Caption = Caption
               If FaceId <> "" Then MenuItem.FaceId = FaceId
               If Divider Then MenuItem.BeginGroup = True
'
           Case 3 ' A SubMenu Item
               If NextLevel = 4 Then
                   Set MenuItem = MenuObject.Controls.Add(Type:=msoControlPopup)
               Else
                   Set MenuItem = MenuObject.Controls.Add(Type:=msoControlButton)
                   MenuItem.OnAction = PositionOrMacro
               End If
               MenuItem.Caption = Caption
               If FaceId <> "" Then SubMenuItem.FaceId = FaceId
               If Divider Then MenuItem.BeginGroup = True
 
            Case 4 ' A SubSubMenu Item
                Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton)
                SubMenuItem.Caption = Caption
                SubMenuItem.OnAction = PositionOrMacro
                If FaceId <> "" Then SubMenuItem.FaceId = FaceId
                If Divider Then SubMenuItem.BeginGroup = True
 
 
        End Select
        Row = Row + 1
    Loop
'
''    Call Fermeture_Feuille_Menu_Général
'
'
End Sub
 
 
Sub DeleteMenu()
'   This sub should be executed when the workbook is closed
'   Deletes the Menus
    Dim MenuSheet As Worksheet
    Dim Row As Integer
    Dim Caption As String
 
    On Error Resume Next
    Set MenuSheet = Sheets("MenuSheet")
    Row = 2
    Do Until IsEmpty(MenuSheet.Cells(Row, 1))
        If MenuSheet.Cells(Row, 1) = 1 Then
            Caption = MenuSheet.Cells(Row, 2)
            Application.CommandBars(1).Controls(Caption).Delete
        End If
        Row = Row + 1
    Loop
    On Error GoTo 0
End Sub
Sub Fermeture_Feuille_Menu_Général()
'
'
    ActiveWorkbook.Close SaveChanges:=False
'
End Sub
'
'
Sub DummyMacro()
    MsgBox "This is a do-nothing macro."
End Sub

Je vous remercie d'avance pour votre aide.

Problème sur la création de menu (menumakr)

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager