Discussion :

[patricktoulon]

Bonjour a tous
la demande ayant été faite par un demandeur novice et utilisant une usine a gaz bourrée d'api pour créer un menupopup (menu contextuel ) dans un userform
je me suis penché sur la question comment simplifier le tout

tout d'abords pour concevoir un popup nous n'avons pas vraiment besoins des apis on utilisera les commandbarpopup qui sont la pour ca d'ailleurs

ensuite j'ai décidé de concevoir carrément une toolbar la je me suis dis bonjour l'usine a gaz

mais non mais non!!!
on va faire très simple avec 3 fois rien
on va faire une fonction dans la quelle on injectera un array un peu particulier contenant toutes les données concernant le popup

voila
on commence par mettre des labels en top de userform et tout le long les uns après les autres

ensuite on va mettre dans leur evenement"click" ce genre de code
ici je vais donner 3 exemple

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
Private Sub Label1_Click()
    Dim boutons
    boutons = Array("Sauver:3:1:macro1", "Sauve sous...:22:1:macro2", "Ouvrir:23:1:macro3", "Importer:128:1:macro4", _
                    Array("plein ecran:457:1:macro7", "normal:458:1:macro8", "affichage"), _
                    "Exporter:129:1:macro5", "Quitter:5955:1:macro6")
    menu boutons, Label1, "usf"
End Sub
Private Sub Label2_Click()
    Dim boutons
    boutons = Array("ajouter du texte:444:1:ajouttext", "mettre le texte en couleur:1916:1:textcolor", "mettre le texte en gras:356:1:textbold", "ombre aux texte:128:7563:ombretexte", _
                    "copier la selection:236:1:copieselect", "formater:824:1:formater")
    menu boutons, Label2, "usf"
End Sub
Private Sub Label3_Click()
    Dim boutons
    boutons = Array("inserer une image:524:1:insertimage", _
                    Array("forme ronde:289:1:macro7", "forme carré:366:1:macro8", "insérer une forme"), "insérer un block texte:356:1:insertextblock")
    menu boutons, Label3, "usf"
End Sub

quèsaco me direz vous
et bien c'est tout simple
décortiquons le label1
boutons = Array("Sauver:3:1:macro1", "Sauve sous...:22:1:macro2", "Ouvrir:23:1:macro3", "Importer:128:1:macro4", _
Array("plein ecran:457:1:macro7", "normal:458:1:macro8", "affichage"), _
"Exporter:129:1:macro5", "Quitter:5955:1:macro6")

voila visuellement c'est plus facile avec les couleur
chaque couleur représente un bouton de la barre popup
dans chaque element de l'array il y a:

1. le nom du bouton (sa caption )
2. le face id (le numéro correspondant a l'icon )
3. son état (0disabled/1enabled)
4. et enfin le nom de la fonction que le bouton est sensé appeler

ces 4 données étant séparées par un ":"

jusque la pas trop compliqué

j'ai mis en gras un élément de l'array qui ne correspond pas a la structure des autres
en effet c'est un array en l'occurrence ici un sub array (un array dans un array)
et bien ce sub array repente vous l'avez compris en regardant sa structure intérieur c'est un submenu
la fonction se charge de placer le sub menu et sa structure

la fonction s'apellera comme suit

menu boutons, Label1, "usf"

remarquez "usf" il est la pour signaler a la fonction que l'on est dans un userform et qu'elle va donc devoir utiliser les apis pour positionner le popup
si vous voulez vous en servir dans un sheets par exemple au clickdroite vous enlevez tout simplement "usf" le popup sortira au point du curseur
voila vous savez comment on appelle la fonction de création du menu

la fonction:

on utilisera pour une commodité visuelle quand même 3/4 api pour un positionnement fixe du popup juste en dessous chaque label
je pense avoir bien fait pour le 32/64 bytes versions excel vous me le direz cas échéant

une chose que vous devez savoir pour un soucis de transportabilité j'ai fait en sorte que tout le code ci dessous puisse être placé dans l'userform ou un module a vous de voir

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
Option Explicit
#If VBA7 Then
    Private Declare ptrsafe Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
    Private Declare ptrsafe Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
    Private Declare ptrsafe Function GetDeviceCaps Lib "gdi32" (ByVal HdC As Long, ByVal nIndex As Long) As Long
    Private Declare ptrsafe Function GetActiveWindow Lib "user32" () As Long
#Else
    Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
    Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
    Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal HdC As Long, ByVal nIndex As Long) As Long
    Private Declare Function GetActiveWindow Lib "user32" () As Long
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
#End If
Private Type RECT: Left As Long: Top As Long: Right As Long: Bottom As Long: End Type
Const LOGPIXELSX = 88
Const LOGPIXELSY = 90
 
Function menu(boutons, bt, Optional mode As String = "")
    Dim i As Long, Barre As CommandBar, pop, e As Long, decal As Long, r As RECT, XX, YiN As Long, HdC As Long, EpS, lpppX As Long, lpppy As Long, YY As Long
    On Error GoTo suite
    delmenu
suite:
    HdC = GetDC(0): lpppX = GetDeviceCaps(HdC, LOGPIXELSX): lpppy = GetDeviceCaps(HdC, LOGPIXELSY)
    Set Barre = CommandBars.Add("MenuUSF", msoBarPopup, False, True)
    For i = 0 To UBound(boutons)
        If IsArray(boutons(i)) Then
            Set pop = Barre.Controls.Add(msoControlPopup, 1, , , True): pop.Caption = boutons(i)(UBound(boutons(i)))
            pop.Caption = boutons(i)(UBound(boutons(i)))
            For e = 0 To UBound(boutons(i)) - 1
                With pop.Controls.Add(msoControlButton, 1, , , True)
                    .Caption = Split(boutons(i)(e), ":")(0)
                    .FaceId = Split(boutons(i)(e), ":")(1)
                    .Enabled = Val(Split(boutons(i)(e), ":")(2))
                    .OnAction = Split(boutons(i)(e), ":")(3)
                End With
            Next
        Else
            With Barre.Controls.Add(msoControlButton, 1, , , True)
                .Caption = Split(boutons(i), ":")(0)
                .FaceId = Split(boutons(i), ":")(1)
                .Enabled = Val(Split(boutons(i), ":")(2))
                .OnAction = Split(boutons(i), ":")(3)
            End With
        End If
    Next
    DoEvents
    If mode = "usf" Then
        GetWindowRect GetActiveWindow, r    ' coordonnées rectangle de l'userform
        XX = bt.Left * lpppX / 72    'position left du label cliqué en pixel
        YY = (bt.Top + bt.Height) * lpppy / 72    ' position top du label cliqué en pixel
        YiN = (bt.Parent.Height - bt.Parent.InsideHeight - 3) * lpppy / 72    ' epaisseur de la caption du userform en pixel
        'YiN = GetSystemMetrics(15) ' autre methode epaisseur de la caption du userform en pixel mais moins precise
        EpS = GetSystemMetrics(5)     ' epaisseur des bordures de l' userform en pixel
        Barre.ShowPopup r.Left + EpS + XX, r.Top + YiN + EpS + YY    ' affichage de la popup au cordonnéees calculées
    Else
        Barre.ShowPopup
    End If
End Function
Function delmenu()
    On Error Resume Next
    CommandBars("MenuUSF").Delete
End Function

et voila une démo



des retours sur l'affichage avec des résolutions différentes me seraient utilises pour confirmer le positionnement avec les apis
merci donc d'avance pour ces retours

[curt]

Bonjour Patrick,

sympa l'astuce. Même si depuis office 2007 je me suis rangé du côté du Ruban, ta méthode est une bonne alternative pour éviter d'avoir à reprendre le ruban si on a juste un Userform à ajouter.

Curt

[gaet76]

Patrick,

Excellent, ton code m'a bien servit.

Je ne voudrais pas abuser de ta bonté mais sais tu si il y a possibilité de mettre des variables dans les pop up?

Je m'explique : dans un userform je voudrais mettre un label "Plus" et quand on clique dessus on aurait "Créé par : ...(la variable)"

Merci d'avance pour ta réponse.

[patricktoulon]

Bonjour
je ne comprends pas vraiment ta demande

si tu entend transporter une variable alors oui dans le sens ou on peut stoker une variable dans le tag du/d'un bouton dans la popup

il suffit comme je l'ai précisé dans la sub qui est appelée par le on action du bouton de se servir de

"commandbars.actionControl.tag"

ou alors il y a la possibilité d'argumenter l'appel de la sub avec des arguments mais c'est déjà beaucoup plus compliqué

mais comme je ne connais pas ton contexte je ne peux t'en dire plus

c'est vrai que c'est quelque chose que je n'ai pas prévu c'est un tord

[gaet76]

Ce que je voudrais faire c'est:

• le label s'appellerais "plus"
• et dans le pop up qui apparaitra quand on aura cliqué sur "plus" je voudrais qu'il y ai d'écrit "Créé par : ... et à la place des pointillé la personne qui l'a créée (cette info ce trouve dans une de mes feuilles de calcul)

J'espère être plus clair.

Mais pour le coup en réfléchissant je sais pas si c'est très pertinent étant donné que je veux pas cliquer sur les infos qui vont apparaitre, mais juste avoir un visu sur ces infos.

Je vais surement faire une petite fenêtre avec les info que je veux.

Merci

[patricktoulon]

non pas vraiment
je pense qu'il me faudrait un exemple de fichier pour comprendre ton besoins

[patricktoulon]

bonjour a tous
c'est un problème assez récurent les api peuvent être rédhibitoire pour certains surtout en cas de version 64 bits excel

après une longue discussion sur un autre sujet j'ai finalement trouver le moyen universel de trouver l'operateur de calcul qui prend en compte le DPI de la résolution de l'écran
en gros convertir les point en pixels sans utiliser les api Windows et GDI pour le positionnement des popups dans le userform
ca se resume a ceci:

Code :

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

With ActiveWindow.ActivePane: oP = (.PointsToScreenPixelsY(3) - .PointsToScreenPixelsY(0)) / 3: End With ' CALCUL DE L OPERATEUR DE CONVERTION

alors voila une version identique a la démo 1 mais sans les apis !!!

code dans l'userform est identique on change rien

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
Private Sub Label1_Click()
       Dim boutons
    boutons = Array("Sauver:3:1:macro1", "Sauve sous...:22:1:macro2:true", "Ouvrir:23:1:macro3", "Importer:128:1:macro4", _
                    Array("plein ecran:457:1:macro7", "normal:458:1:macro8", "affichage"), _
                    "Exporter:129:1:macro5", "Quitter:5955:1:macro6")
    menu boutons, Label1, "usf"
End Sub
Private Sub Label2_Click()
    Dim boutons
    boutons = Array("ajouter du texte:444:1:ajouttext", "mettre le texte en couleur:1916:1:textcolor", "mettre le texte en gras:356:1:textbold", "ombre aux texte:128:7563:ombretexte", _
                    "copier la selection:236:1:copieselect", "formater:824:1:formater")
    menu boutons, Label2, "usf"
End Sub
Private Sub Label3_Click()
    Dim boutons
    boutons = Array("inserer une image:524:1:insertimage", _
                    Array("forme ronde:289:1:macro7", "forme carré:366:1:macro8", "insérer une forme"), "insérer un block texte:356:1:insertextblock")
    menu boutons, Label3, "usf"
End Sub

et maintenant le code de création des pop-ups dans un module standard ou dans le userform comme vous voulez

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
 
Option Explicit
'' PLUS D APIS 
Function menu(boutons, bt, Optional mode As String = "")
    Dim i As Long, Barre As CommandBar, pop, e As Long, decal As Long, XX, YY As Long, oP As Double, topplus, leftplus, ep_cadre
    On Error GoTo suite
    delmenu
suite:
     With ActiveWindow.ActivePane: oP = (.PointsToScreenPixelsY(33) - .PointsToScreenPixelsY(0)) / 33: End With ' CALCUL DE L OPERATEUR DE CONVERTION 
    Set Barre = CommandBars.Add("MenuUSF", msoBarPopup, False, True)
    For i = 0 To UBound(boutons)
        If IsArray(boutons(i)) Then
            Set pop = Barre.Controls.Add(msoControlPopup, 1, , , True): pop.Caption = boutons(i)(UBound(boutons(i)))
            pop.Caption = boutons(i)(UBound(boutons(i)))
            For e = 0 To UBound(boutons(i)) - 1
                With pop.Controls.Add(msoControlButton, 1, , , True)
                    .Caption = Split(boutons(i)(e), ":")(0)
                    .FaceId = Split(boutons(i)(e), ":")(1)
                    .Enabled = Val(Split(boutons(i)(e), ":")(2))
                    .OnAction = Split(boutons(i)(e), ":")(3)
                End With
            Next
        Else
            With Barre.Controls.Add(msoControlButton, 1, , , True)
                .Caption = Split(boutons(i), ":")(0)
                .FaceId = Split(boutons(i), ":")(1)
                .Enabled = Val(Split(boutons(i), ":")(2))
                .OnAction = Split(boutons(i), ":")(3)
                If UBound(Split(boutons(i), ":")) > 3 Then .BeginGroup = True
            End With
        End If
    Next
    DoEvents
    If mode = "usf" Then
 
        XX = bt.Left * oP        'position left du label cliqué en pixel par raport au point 0 du insidewidth de l'userform
        YY = (bt.Top + bt.Height) * oP       ' position top du label cliqué en pixel en dessous le bouton par rapport au point 0 du insideheight de l'userform
        topplus = (bt.Parent.Height - bt.Parent.InsideHeight) * oP     ' epaisseur de la caption du userform en pixel
        ep_cadre = bt.Parent.Width - (bt.Parent.InsideWidth)  'epaiseur du cadre (donne 3 en general)
         Barre.ShowPopup (UserForm1.Left * oP) + ep_cadre + XX, UserForm1.Top * oP + topplus - ep_cadre + YY ' affichage de la popup au cordonnéees calculées
    Else
        Barre.ShowPopup
    End If
End Function
Function delmenu()
    On Error Resume Next
    CommandBars("MenuUSF").Delete
End Function

et voila c'est exactement le même mais sans api

[Ymerej13]

Bonjour,

Je suis novice en programmation et j'ai tenté de rajouter un 3ème Array afin d'avoir un menu encore plus complet. (Array dans Array dans Array)

Cependant une erreur se crée :

Set Barre = CommandBars.Add("MenuUSF", msoBarPopup, False, True)

Pouvez vous me guider ?

Merci d'avance.

[patricktoulon]

bonjour

ca veut dire que tu a essayé de la créer puis de la recréer sans la supprimer
sur cette ligne je vois que ca comme raison de l'erreur

après tu me dit "array dans array dans array" je ne sais plus si j'ai prévu des subsubmenu ca m'étonnerait que non mais bon je vérifierais a temps perdu

[Ymerej13]

Merci pour cette réponse rapide.

C'est à dire ? Je ne comprends pas.

Je l'ai écris comme ça :

Code :

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

1
2
3
4
5
6
7
8
Private Sub lbl3_Click()
    Dim boutons
    boutons = Array("Catalogue SM6:524:1:insertimage", _
                    Array( _
                    Array("SEPAM 10:457:1:macro7", "SEPAM 20:458:1:macro8", "SEPAM 40:458:1:macro8", "SEPAM 60:458:1:macro8", "SEPAM 80:458:1:macro8", "Flair 23DM:458:1:macro8", "SEPAM et Flair"), _
                    "Autres:366:1:macro8"))
    menu boutons, lbl3, "usf"
End Sub

Le fait de mettre 3 Array l'un dans l'autre ne pose pas de problème dans les fait ?

[patricktoulon]

re
alors oui en effet apres verifiquation il n'est pas prévu de descendre plus d'un cran en terme de sub menu

ce n'est donc pas possible comme tel

je modifierais ce point des que j'ai un moment

[patricktoulon]

oulah!!!!!
non en fait tu n'apas compris le principe
dit moi si c'est cela que tu veux


au quel cas c'est cela

Code :

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

1
2
3
4
Dim boutons
 boutons = Array("Catalogue SM6:524:1:insertimage", Array("SEPAM 10:457:1:macro7", "SEPAM 20:458:1:macro8", "SEPAM 40:458:1:macro8", "SEPAM 60:458:1:macro8", "SEPAM 80:458:1:macro8", "Flair 23DM:458:1:macro8", "SEPAM et Flair"), _
 "Autres:366:1:macro8")
 menu boutons,lbl3, "usf"

voila

[Ymerej13]

Oui c'est exactement ça !

Merci !

[Ymerej13]

Pourrez vous quand même m'expliquer comment mettre plus de Array afin de hiérarchiser encore plus ?

Exemple :

Cours
Cours de mathématique
Cours de base
Cours complexes
Équations différentielles
Algorithmes

Code :

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

1
2
boutons = Array("Cours:524:1:insertimage", Array("Cours de base:457:1:macro7", Array("Equations différentielles:457:1:macro7", "Algorithmes:458:1:macro8", "Cours complexes"), "Cours de mathématiques"))
    menu boutons, lbl3, "usf"

Ceci conviendrait ?
Merci d'avance

[patricktoulon]

re
il me semble t'avoir dis que comme tel avec ma fonction ce n'était pas possible

les submenus ne peuvent être que des enfants de la barre

c'est toute la conception de la fonction qu'il faudrait revoir

[abdel091]

Bonjour,
Est-il possible d'avoir un exemple de code lorsque l'on clique sur un bouton du menu déroulant?
Merci d'avance.

[patricktoulon]

re
bonjour
a question claire réponse claire
dans le cas présent ca ne l'est pas
c'est quoi un menu déroulant ???

[abdel091]

re
bonjour
a question claire réponse claire
dans le cas présent ca ne l'est pas
c'est quoi un menu déroulant ???

Re
Le menu déroulant est la toolbar
J'ai essayer votre code, ça fonctionne très bien mais je voudrais ajouter du code lorsque un utilisateur clique sur un bouton.
Par exemple j'ai crée 2 procedures

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
sub macro1()
UserForm2.show
end sub
 
sub macro2()
unload UserForm1
end sub
 
Private Sub Label1_Click()
    Dim boutons
    boutons = Array("importer donnée:254:1:macro1,"Quitter:5955:1:macro2")
    menu boutons, Label1, "usf"
End Sub

Le problème c'est que lorsque je clique sur 2 les boutons ça m'ouvre le fichier excel dans lequel se trouve le code.

[patricktoulon]

a ben a ce que je vois tu a compris le procédé alors il est ou ton soucis
tes macro met les dans un modules et c'est tout

Le problème c'est que lorsque je clique sur 2 les boutons ça m'ouvre le fichier excel dans lequel se trouve le code.

???????????????

[abdel091]

a ben a ce que je vois tu a compris le procédé alors il est ou ton soucis
tes macro met les dans un modules et c'est tout


???????????????

C'est bon ça marche, j'avais mis les procédures macro1 & 2 dans le Userform et non dans un module.
Sinon est-il possible d'implémenter votre code dans un UserForm provenant de word et non d'excel?
merci d'avance.