Création d'un menu déroulant à partir d'une userform

**Tcool27** · 14/09/2014, 10h15

Bonjour,
Je souhaite faire la création d'un menu "A propos de" à partir d'une UserForm.
Ce menu devra ensuite charger une autre UserForm.
Le code ci-dessous est en erreur d'exécution 5 et ne fonctionne pas avec mes autres lignes de codes.
Si vous avez plus simple, je suis preneur.
Merci d'avance pour votre aide.

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
Option Explicit
 
Dim X As Single
Dim Y As Single
 
 
Private Sub UserForm_Initialize()
    Dim Barre As CommandBar
 
    Set Barre = CommandBars.Add("MenuUSF", msoBarPopup, False, True)
 
    With Barre.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "Menu 01"
        .FaceId = 50
        .OnAction = "Macro1"
    End With
 
    With Barre.Controls.Add(msoControlButton, 2, , , True)
        .Caption = "Menu 02"
        .FaceId = 49
        .OnAction = "Macro2"
    End With
 
 
    With Me
        X = (.Width - .InsideWidth) / 2 + 8
        Y = .Height - .InsideHeight - X + 24
    End With
End Sub
 
 
Private Sub Label1_Click()
    Dim PosX As Single, PosY As Single
 
    PosX = (Me.Left + X + Label1.Left) * 4 / 3
    PosY = (Me.Top + Y + Label1.Top) * 4 / 3
 
    Application.CommandBars("MenuUSF").ShowPopup PosX, PosY
End Sub
 
 
 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    On Error Resume Next
    CommandBars("MenuUSF").Delete
End Sub

**patricktoulon** · 14/09/2014, 10h52

Bonjour

chez moi j'ai changé la position
et j'ai une erreur "400" l'ors du 2 click
j'avoue que je n'est pas d'explication ???????????

**Daniel.C** · 14/09/2014, 10h53

Bonjour,

Je ne suis pas un spécialiste des commandbars, mais il est possible que tu ne puisses pas t'en servir comme dans les versions antérieures à Excel 2007. Regarde l'aide VBA sur "ShowPopup".

**patricktoulon** · 14/09/2014, 11h08

mais non!!!

en fait meme avec 2007 maintenant(certainement du a une mise a jour ) on ne peut pas mettre les sub apellées par le on action dans le module userform
je viens de faire l'essai avec un que j'avais fait il y a plus de 2 ans et j'ai la même erreur hors avnt je ne l'avais pas

code amettre dans le userform

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
Option Explicit
 
 
Private Sub UserForm_Initialize()
     deletebar "MenuUSF"
  Dim barre As CommandBar
 
    Set barre = CommandBars.Add("MenuUSF", msoBarPopup, , True)
 
    With barre.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "Menu 01"
        .FaceId = 50
        .OnAction = "Macro1"
    End With
 
    With barre.Controls.Add(msoControlButton, 2, , , True)
        .Caption = "Menu 02"
        .FaceId = 119
        .OnAction = "Macro2"
    End With
 
 
End Sub
 
 
Private Sub Label1_Click()
     Dim PosX As Long, PosY As Long
 
 
    PosX = Round((Me.Left + Label1.Left) * 4 / 3)
    PosY = Round((Me.Top + Label1.Top) * 4 / 3)
 
    Application.CommandBars("MenuUSF").ShowPopup PosX, PosY
End Sub
 Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
   deletebar "MenuUSF"
End Sub

code a mettre dans un module standard

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub deletebar(barre)
On Error Resume Next
    CommandBars("MenuUSF").Delete
 End Sub
 
Sub macro1()
'le code de ta macro ici
End Sub
Sub macro2()
' le code de ta macro ici
End Sub

Au plaisir

**Tcool27** · 14/09/2014, 11h46

Merci à tous pour votre aide. Je passe la main sur ce module. Je vais faire d'une autre façon.

**patricktoulon** · 14/09/2014, 11h52

et pour être plus précis
mettre tout dans un module standard
je ne sais pas ou tu voulais voir apparaitre ton menu moi je le fait apparaitre a droite du label
code pour le module standard

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
Sub createbar()
    deletebar "MenuUSF"
  Dim barre As CommandBar
 
    Set barre = CommandBars.Add("MenuUSF", msoBarPopup, , True)
 
    With barre.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "Menu 01"
        .FaceId = 50
        .OnAction = "Macro1"
    End With
 
    With barre.Controls.Add(msoControlButton, 2, , , True)
        .Caption = "Menu 02"
        .FaceId = 119
        .OnAction = "Macro2"
    End With
End Sub
Sub deletebar(barre)
On Error Resume Next
    CommandBars(barre).Delete
 End Sub
 
Sub macro1()
'le code de ta macro ici
End Sub
Sub macro2()
' le code de ta macro ici
End Sub

et le code pour l'userform

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
Option Explicit
 
Private Sub UserForm_Initialize()
    createbar
End Sub
 
Private Sub Label1_Click()
    Dim PosX As Long, PosY As Long
    PosX = Round(Me.Left + Label1.Left) * 1.75
    PosY = Round(Me.Top + Label1.Top) * 1.75
    Application.CommandBars("MenuUSF").ShowPopup PosX, PosY
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    deletebar "MenuUSF"
End Sub

Invité · 14/09/2014, 12h25

Salut,

Le probklème vient de la Méthode Add et/ou de la méthode Delete.

Commence le code par :

Code :

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

1
2
3
On resume error next
CommandBars(USF_MENU_NAME).Delete
On error Goto 0

Pour ajouter, il ne faut pas qu'il existe déjà un menu du même nom, et pour supprimer, il faut qu'il existe un menu du nom spécifié, alors tu peux largement utiliser On Error dans les 2 cas sans dire que ça soit de la mauvaise programmation.

A+

**Tcool27** · 14/09/2014, 13h20

Envoyé par Nouveau2

Salut,

Le probklème vient de la Méthode Add et/ou de la méthode Delete.

Commence le code par :

Code :

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

1
2
3
On resume error next
CommandBars(USF_MENU_NAME).Delete
On error Goto 0

Pour ajouter, il ne faut pas qu'il existe déjà un menu du même nom, et pour supprimer, il faut qu'il existe un menu du nom spécifié, alors tu peux largement utiliser On Error dans les 2 cas sans dire que ça soit de la mauvaise programmation.

A+

Bonjour,
Effectivement, ce module est très bien développé.
Merci pour cette dernière réponse.
Je classe l'affaire.

**patricktoulon** · 14/09/2014, 13h55

c'est pour ca que dans les 2 derniers exemple je détruit juste avant la création dans une sub séparée

avec on error resume next dans cette sub
résultat si il elle existe elle est supprimée sinon rien

pour faire plus propre il y a aussi la solution de boucler sur les commandbars buildin mais j'ai été un peu fainéant
voir meme boucler sur son nom

Code :

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

1
2
3
For Each cmb In Application.CommandBars
If cmb.Name = "MenuUSF" Then cmb.Delete
Next

en plus la dernière version te permet de modifier dynamiquement un control voir même en ajouter
mais ca c'est un autre sujet

Invité · 14/09/2014, 15h07

Envoyé par patricktoulon

c'est pour ca que dans les 2 derniers exemple je détruit juste avant la création dans une sub séparée

avec on error resume next dans cette sub
résultat si il elle existe elle est supprimée sinon rien

Oui effectivement, je n'avais pas fais attention.
Je n'avais importé dans mon IDE que le code du 1er post de Tcool27.

donc

---------------------------------------------------

Envoyé par Tcool27

Bonjour,
Effectivement, ce module est très bien développé.

Oui, il a l'air bien développé.

Merci pour cette dernière réponse.

De rien.

@+