PopUpMenu Avec FaceId

Version imprimable

Voir 40 message(s) de cette discussion en une page

1 pièce(s) jointe(s)

PopUpMenu Avec FaceId

Bonjour,

Pouvez-vous me dire dans ce fichier comment faire pour intégrer les FaceId dans le Code.

Je sais que ça se stiue dans le module :

Code:

1
2
3
4
5
6
7
8
9
10
Public Type Erg1
    Iindex          As Long
    Itxt            As String
    Icheck          As Boolean
    ISiCheck        As Long
    ISiUnCheck      As Long
    IEnabled        As Boolean
    Ikey            As Variant
    Iflag           As Long
End Type

Et dans le module de classe :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Public Sub AddLigne(Index As Long, Txt As String, Optional Check As Boolean, Optional Enabled As Boolean = True, Optional Key As Variant = 0&, Optional ByVal SiCheck As Long = 0&, Optional ByVal BmpCheck As Long = 0&)
'   ajoute une ligne au tableau MemoMenuF
Dim i As Long
    On Error Resume Next
 
    i = UBound(MemoMenuF) + 1
    If Err <> 0 Then ReDim MemoMenuF(0): i = 1
    ReDim Preserve MemoMenuF(i)
 
'   Mémorise la ligne
    With MemoMenuF(i)
        .Iindex = Index
        .Itxt = Txt
        .Icheck = Check
        .ISiCheck = SiCheck
        .IEnabled = Enabled
        .Ikey = Key
        .Iflag = DetermineFlag(MemoMenuF(i))
    End With
End Sub

Merci pour votre aide.
Bien Cdt.

Pièce jointe 249209

28/02/2017, 16h36
kiki29

1 pièce(s) jointe(s)

Salut, voir ici ou mieux là

P.-S. : je n'ouvre plus les PJ.

1 pièce(s) jointe(s)

re
bonjour
quand je pense q'une 10 ne de ligne suffisent a créer son menu la pauvre elle est allé me chercher l'exemple avec les apis et en plus c'est le plus viel exemple que je connaisse:roll:

non c'est pas sérieux

tout se fait dans cette ligne
boutons = Array("Sauver:3:0:macro1", "Sauve sous...:22:1:macro2", "Ouvrir:23:1:macro3", "Importer:128:1:macro4", _
"Exporter:129:1:macro5", "Quitter:5955:1:macro6")

voila chaque couleurs représente un bouton
tu a le nom du bouton suivi de son face id suivi de sont état au départ suivi du nom de la macro qui est sensé appeler
chaque partie étant séparé par un ":"

allez prends un userform vierge
colle lui un label et c'est tout
maintenant tu va coller cela dans le module du userform
Code:

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 Option Explicit Private Sub Label1_Click() Dim boutons, i As Long, Barre As CommandBar boutons = Array("Sauver:3:0:macro1", "Sauve sous...:22:1:macro2", "Ouvrir:23:1:macro3", "Importer:128:1:macro4", _ "Exporter:129:1:macro5", "Quitter:5955:1:macro6") On Error GoTo suite CommandBars("MenuUSF").Delete suite: Set Barre = CommandBars.Add("MenuUSF", msoBarPopup, False, True) For i = 0 To UBound(boutons) 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 Next Barre.ShowPopup End Sub 'Supprime la barre d'outils lors de la fermeture du UserForm Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) On Error Resume Next CommandBars("MenuUSF").Delete End Sub
allez pour changer une démo
Pièce jointe 249394

01/03/2017, 13h28
GuiJenn34

1 pièce(s) jointe(s)

Bonjour,

C'est super :) !

Comment peut-on faire pour dire on doit s'afficher le MenuPopup ?

Exemple image : Ici en dessous du label
Pièce jointe 249601

Merci Bien Cdt

Salut,
l'evenement Mouse Move devrait correspondre

Code:

1
2
3
Private Sub TonLabel_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 
End Sub

1 pièce(s) jointe(s)

re

Citation:

Comment peut-on faire pour dire on doit s'afficher le MenuPopup ?

a vrai dire je comprends pas bien ta question
si tu parle a quel moment tu veut l'afficher tu a les évènement moi je me sert du click tu peut te servir du move aussi
si cela n'est pas ta question précise ta demande
pour le fun hier car ca fait longtemps que je ne m'était pas amuser avec ca je suis allé un peu plus loin
j'ai modifier afin qu'avec boutons on puisse gérer aussi les subsmenus
exemple
encore une fois tout se gère dans 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")

donc ici encore une fois chaque couleur représente un bouton
Mais!!!!!
je te l'ai mis en gras !!! :parmi les boutons il y a un array avec des bouton dedans
en fait il représente un submenu
le nom(caption) du sub menu est toujours le derniers en l'occurrence ici affichage
dans la fonction:!!
si c'est pas un array on fait comme d'habitude on ajoute le bouton avec les données du split
si c'est un array par contre on ajoute un msocontrolpopup
et on boucle sur cet array jusqu'à l'avant dernier et on ajoute les boutons non a la barre mais a ce contropopup
de la même manière qu'avec les boutons pour la barre
et voila le tour est joué
Code:

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 Option Explicit Private Sub Label1_Click() Dim boutons, i As Long, Barre As CommandBar, pop, e 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") On Error GoTo suite CommandBars("MenuUSF").Delete suite: Set Barre = CommandBars.Add("MenuUSF", msoBarPopup, False, True) For i = 0 To UBound(boutons) If IsArray(boutons(i)) Then Debug.Print TypeName(boutons(i)) Set pop = Barre.Controls.Add(msoControlPopup, 1, , , True) 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 Barre.ShowPopup End Sub 'Supprime la barre d'outils lors de la fermeture du UserForm Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) On Error Resume Next CommandBars("MenuUSF").Delete End Sub
démonstartion :
Pièce jointe 249616
voila un beau menu contextuel n'est ce pas ?
l'avantage de travailler sans les apis c'est que ces deux exemples seront compatibles toute versions d'Excel
c'est du plus basique en terme de commandbars

voila voila
on est quand même loin de l'usine a gaz avec les apis non???

01/03/2017, 17h55
GuiJenn34

1 pièce(s) jointe(s)

Alors là au top pour le sous-menu !!

Ma question est vrai n'est pas parlante ci-joint ce que je voudrais que ça face :
En gros dire ou je souhaite faire apparaître le Popmenu

Pièce jointe 249788

Actuellement le menu s'affiche juste en dessous du curseur, et j'aimerai qu'il s'affiche en dessus du label (par exemple)

Et autre question comment fait-on pour ajouter un espace entre chaque menu ?

En te remerciant beaucoup ton code c'est vraiment au top :)

1 pièce(s) jointe(s)

oui j'ai travailler un peu dessus cet aprèm travaillant sur un autre projet en javascript j'ai pas eu beaucoup de temps
mais ca tombe bien avant de la proposer aux contributions il faut tester

donc!!!!
dans cette version j'ai séparer le code de construction de l'évènement pour en faire une fonction
j'ai ajouter aussi la possibilité de s'en servir sur un sheets aussi géré par l'argument "usf" dans l'appel a la fonction

pour l'exemple j'ai mis non pas 1 ni 2 mais 3!!!!! labels
et oui 3 menu différent avec la même fonction
avec l'argument "usf" la fonction considère que l'on est dans un userform alors elle place le popup juste en dessous du label au même left a 2 millimètres prêt et cela sans apis
allez c'est parti
prend un userform met lui 3 label ou tu veux je dis bien ou tu veux

dans le module on va metre nos 3 click des labels

Code:

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", "inserer une forme"), "inserer un block texte:356:1:insertextblock")
    menu boutons, Label3, "usf"
End Sub

tu reconnais la structure le l'array pour les boutons je n'ai plus besoins de te mettre des couleurs hein !!!
voila maintenant tu va rajouter le code de construction c'est le même j'ai fait juste 2 ou 3 modifs de rien du tout
ajoute ca dans le module avec le reste

Code:

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
Function menu(boutons, bt, Optional mode As String = "")
    Dim i As Long, Barre As CommandBar, pop, e As Long, decal As Long
    On Error GoTo suite
    delmenu
suite:
    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
        decal = IIf(bt.Left <> 0, bt.Left * 1.72, 5)
        Barre.ShowPopup Me.Left * 1.669 + decal, ((Me.Top * 1.669) + 30) + bt.Height * 1.669 + bt.Top * 1.669
    Else
        Barre.ShowPopup
    End If
End Function
 
Function delmenu()
    On Error Resume Next
    CommandBars("MenuUSF").Delete
End Function

sans oublier l'évènement de fermeture de l'userform qui va détruire la dernière barre construite

Code:

1
2
3
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    delmenu
End Sub

et voila moins de 30 lignes et 3 menus différents et tout i cointi
demo en image
Pièce jointe 249836

1 pièce(s) jointe(s)

Re :)

C'est super qui est un module à part pour la création du menu.
En revanche ça ne donne pas le même résultat que toi :

Pièce jointe 250033

Dans ton code tout est calculé selon l'emplacement de tous les Labels. Si ils sont plus ou moins éloigné le menu ne se mets pas aligné à gauche du label cliqué. (Ralala je pense pas être clair)
Il faudrait avoir l'emplacement Label par label du menu. Du style :
Code:

1 2 3 4 5 6 7 8 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" Position Label1.Left, Label1.Top + Label1.Height + 18 End Sub
Malheureusement je ne suis pas arrivé à intégrer la position dans le module de label.

02/03/2017, 13h24
patricktoulon

re

re
Bonjour non en fait les calculs sont fait pour mon ecran en code dur pour généraliser je vais devoir employer les apis je regarderais cela se soir pour faire au plus simple
je vais devoir faire pour 64 et 32 byte versions excel
puré depuis le temps Microsoft n'a pas encore ajouté cette fonction dans leur VBa, obligé d'utiliser les librairie Windows
fait Ch.....!!!!
02/03/2017, 13h43
GuiJenn34

En tout cas en grand merci.
Ton menu se tient en quelques lignes, c'est génial !!

Malheureusement j'ai essayé aussi de mon coté me je suis pas assez compétent !!
Tu sais aussi comment dans ton menu insérer un espace vide (ou séparation) ?

Bonne aprèm !!
02/03/2017, 17h15
patricktoulon

re

bonjour
allez bonne lecture de ceci:
10/03/2017, 13h01
GuiJenn34

Bonjour,

Je viens d'intégrer ton code sur mon USF et c'est parfait. Merci d'avoir pris le temps :)

Comment fais-tu pour ajouter un espace pour séparer de ligne ?

En tout cas merci beaucoup.
14/03/2017, 12h44
patricktoulon

1 pièce(s) jointe(s)

re

Bonjour
tu cherche toujours a mettre des séparateurs ?
comme ci par exemple

Pièce jointe 253794
15/03/2017, 13h32
GuiJenn34

Bonjour,

Oui c'est ça comment faire ?
Et encore une autre question comment dans un autre label peut-on faire pour récupérer le nom (caption) du bouton sélectionné ?

Merci
21/03/2017, 12h34
GuiJenn34

patricktoulon.

Tu pourras me dire ? :)

Merci Bien Cdt.

1 pièce(s) jointe(s)

alors!
tout d'abords Bonjour

ensuite
pour tes séparateurs
il y a la propriété .BeginGroup = True qui ajoute un separateur juste au dessus

ensuite pour capter quel bouton a éré cliqué et en récupérer le nom(caption)
il y a la fonction :CommandBars.ActionControl.caption (.tag a la place de caption si tu veux le tag )

alors pour les séparateur il y a encore pas grand chose a modifier dans mon model

on va ajouter simplement ":true" a la fin de chaque boutons dans le array de commande voila ca c'est juste pour les commande de construction
le separateur sera placer au dessus de ce bouton on est bien d'accords

maintenant la petite modif dans la fonction de creation tu va voir c'est 3 fois rien

la modif est simple on ajoute apres tout les attributions des propriété du bouton ceci:

Code:

1
2
 
If UBound(Split(boutons(i), ":")) > 3 Then .BeginGroup = True

en fait on a plus 4 prop dans chaque element de l'array mais 4 ou 5 selon ton besoins

je te redonne la fonction de creation en entier et modifiée

Code:

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
 
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)
                .BeginGroup = True
                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
        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

démonstration
Pièce jointe 256307

Oui dsl Bonjour,

Encore une fois niquel pour la partie séparateur.

En revanche je n'arrive pas et faire la partie : CommandBars.ActionControl.caption (.tag a la place de caption si tu veux le tag)
Il faut que je mette le code ou ?

En gros dans mon USF j'ai ceci :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Private Sub Label1_Click() Dim boutons Label1.Font.Bold = True: Label1.SpecialEffect = 2: Label1.ForeColor = RGB(0, 0, 110) boutons = Array( _ "&Ouvrir:23:1:Ouvrir", _ "&Enregistrer:3:1:Enregistrer:true", _ "&Imprimer:4:1:Imprimer", _ "&Couper:21:0:Couper:", _ "&Coller:171:0:Coller", _ Array("&Couper Son:478:1:Couper_son", "&Remettre Son:272:1:Remettre_Son", "&Son Application"), _ "&Quitter:1088:1:Quit:") menu boutons, Label1, "usf" Label1.Font.Bold = False: Label1.SpecialEffect = 3: Label1.ForeColor = RGB(0, 0, 0) Label5 = "Nom (Caption) du bouton cliqué" End Sub
Et j'aimerai récupérer le caption du bouton cliqué dans le Label5 du USF (Et sur tout autre support autre que le USF également), car j'ai une parti qui est créé un menuPop dans le classeur excel avec le bouton gauche de la souris.

Encore merci pour ton aide.

21/03/2017, 14h54
patricktoulon

re

re
oui c'est dans la sub ou fonction qui est appellée qu'il faut le mettre

exemple si ton bouton a pour onaction="trucbidule"

alors dans la sub trucbidule
tu mettra
Label5.caption=commandbars.ActionControl.caption

voila
attention comme tes sub sont certainement dans un module standard il faut ajouter le nom du userform devant ou la variable qui lui correspond si il y en a une

exemple
userform1.Label5.caption=commandbars.ActionControl.caption
21/03/2017, 15h03
patricktoulon

1 pièce(s) jointe(s)

re

démonstration :
Pièce jointe 256345

Voir 40 message(s) de cette discussion en une page