Menu Flotan avec face Id
Bonjour
Dans ce lien (Ci dessous) le code est très simple pour un menu flottant.
En revanche comment faire pour rajouter une faceId (Icône à coté du menu flottant) ?
https://www.commentcamarche.net/faq/27517-vba-vb6-un-menu-flottant-type-popupmenu
Merci pour votre aide
Dans ce lien (Ci dessous) le code est très simple pour un menu flottant.
En revanche comment faire pour rajouter une faceId (Icône à coté du menu flottant) ?
https://www.commentcamarche.net/faq/27517-vba-vb6-un-menu-flottant-type-popupmenu
Merci pour votre aide
2 réponses
-
Bonjour,
Pour moi, apres petites verif, pas possible d'ajouter faceId avec ce code (API de Windows), juste coche devant ligne active ou pas
ici pas de probleme, code pour faceId
https://docs.microsoft.com/fr-fr/previous-versions/office/gg987030(v=office.14)?redirectedfrom=MSDN
pour les faceId:
'icones .Faceld: https://fring.developpez.com/vba/excel/faceid/ -
Bonjour,
Et en modifiant un peu ce code ?
Car je connais les autres (enfin connaitre... j'ai déjà vu) et c'est plus lourd.
Alors que celui-ci est beaucoup plus simple. Je connais la ligne active ou non.
Il faut mettre ,true ou ,false. Mais avec un icône devant c'est plus sympa visuellement.
Merci pour ton aide :)-
Re,
Et en modifiant un peu ce code ?
Ben, non, pas possible ou alors lancez-vous dans la modif des API de windows
(enfin connaitre... j'ai déjà vu) et c'est plus lourd.
Peut-etre, mais vous avez ce que vous voulez.......
je connais la ligne active ou non.
dans l'autre aussi propriete .Enabled true ou false
Mais c'est vous qui voyez......... -
@f894009Re,
Non mais bien évidement que je ne demande pas de modifier les API Windows.
Mais modifier mon code pour que je puisse intégrer les Icône.
Merci -
-
@f894009Celui qui est dans le fichier excel que j'ai un peu retouché :
*Voir les codes dans les modules aussi
UserformPrivate WithEvents LN_MenuF As LN_MenuFlottant
Dim T_Check As Boolean
Private Function MeHwnd() As Long: MeHwnd = FindWindowA(vbNullString, Me.Caption): End Function
Private Sub Position(X As Single, Y As Single)
Place.X = (Me.Left + X) * PtTw: Place.Y = (Me.Top + Y) * PtTw
End Sub
Private Sub Label4_Click()
Position Label4.Left, Label4.Top + Label4.Height + 18
Label4.SpecialEffect = 2
Set LN_MenuF = New LN_MenuFlottant
With LN_MenuF
.Handle = MeHwnd
.AddLigne 101, "Sauver", T_Check
.AddLigne 102, "Sauve sous..."
.AddLigne 103, "Ouvrir"
.AddLigne 0, "0" ' met un séparateur
.AddLigne 104, "Importer"
.AddLigne 105, "Exporter"
.AddLigne 0, "0" ' met un séparateur
.AddLigne 106, "Quitter"
.VoirMenuF True 'affiche le menu
End With
Label4.SpecialEffect = 1
End Sub
Private Sub Label5_Click()
Position Label5.Left, Label5.Top + Label5.Height + 18
Label5.SpecialEffect = 2
Set LN_MenuF = New LN_MenuFlottant
With LN_MenuF
.Handle = MeHwnd
.AddLigne 201, "A Propo"
.AddLigne 202, "Index"
.VoirMenuF True 'affiche le menu
End With
Label5.SpecialEffect = 1
End Sub
Private Sub LN_MenuF_ClicMF(ByVal Index As Long)
IDX = MemoMenuF(Index).Iindex
Label3.Caption = MemoMenuF(Index).Itxt
Select Case IDX
Case 101
T_Check = Not T_Check
MsgBox T_Check
Case 106
Unload Me
End Select
End Sub
Private Sub UserForm_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
' If Button = 1 Then MsgBox "Vous avez effectué un clic Gauche."
If Button = 2 Then
Set LN_MenuF = New LN_MenuFlottant
With LN_MenuF:
.Handle = MeHwnd
.AddLigne 101, "Propriétés"
.AddLigne 0, "0"
.AddLigne 106, "Quitter"
.VoirMenuF
End With
End If
End Sub
Dans Les Modules :Private WithEvents LN_MenuF As LN_MenuFlottant
Dim T_Check As Boolean
Private Function MeHwnd() As Long: MeHwnd = FindWindowA(vbNullString, Me.Caption): End Function
Private Sub Position(X As Single, Y As Single)
Place.X = (Me.Left + X) * PtTw: Place.Y = (Me.Top + Y) * PtTw
End Sub
Private Sub Label4_Click()
Position Label4.Left, Label4.Top + Label4.Height + 18
Label4.SpecialEffect = 2
Set LN_MenuF = New LN_MenuFlottant
With LN_MenuF
.Handle = MeHwnd
.AddLigne 101, "Sauver", T_Check
.AddLigne 102, "Sauve sous..."
.AddLigne 103, "Ouvrir"
.AddLigne 0, "0" ' met un séparateur
.AddLigne 104, "Importer"
.AddLigne 105, "Exporter"
.AddLigne 0, "0" ' met un séparateur
.AddLigne 106, "Quitter"
.VoirMenuF True 'affiche le menu
End With
Label4.SpecialEffect = 1
End Sub
Private Sub Label5_Click()
Position Label5.Left, Label5.Top + Label5.Height + 18
Label5.SpecialEffect = 2
Set LN_MenuF = New LN_MenuFlottant
With LN_MenuF
.Handle = MeHwnd
.AddLigne 201, "A Propo"
.AddLigne 202, "Index"
.VoirMenuF True 'affiche le menu
End With
Label5.SpecialEffect = 1
End Sub
Private Sub LN_MenuF_ClicMF(ByVal Index As Long)
IDX = MemoMenuF(Index).Iindex
Label3.Caption = MemoMenuF(Index).Itxt
Select Case IDX
Case 101
T_Check = Not T_Check
MsgBox T_Check
Case 106
Unload Me
End Select
End Sub
Private Sub UserForm_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
' If Button = 1 Then MsgBox "Vous avez effectué un clic Gauche."
If Button = 2 Then
Set LN_MenuF = New LN_MenuFlottant
With LN_MenuF:
.Handle = MeHwnd
.AddLigne 101, "Propriétés"
.AddLigne 0, "0"
.AddLigne 106, "Quitter"
.VoirMenuF
End With
End If
End SubPublic Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
' Obligé de mettre le Type et le tableau dans un module
' pour les avoir en Public.
Option Explicit
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
Public MemoMenuF() As Erg1
Public Type POINTAPI
X As Long
Y As Long
End Type
Public Place As POINTAPI
Public Const PtTw = 1.3433
'Pour ouvrir avec le raccourci.. Ctrl+m
Sub AffiUF()
PopUpMenu.Show 0
End Sub -
@GuitouBonjour,
Mettez votre fichier a dispo si vous voulez, mais vous ne pouvez pas avoir d'icone avec ce code, pourtant pas complique a comprendre
-
