Menu Flotan avec face Id

Guitou -
f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention - 27 févr. 2017 à 15:41

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

Afficher la suite

A voir également:

Vba faceid
Menu déroulant excel - Guide
Face time - Guide
Id telephone - Guide
Menu caché tv continental edison ✓ - Forum Téléviseurs
Https //id.sonyentertainmentnetwork.com/id/management/ ✓ - Forum PS4

2 réponses

Réponse 1 / 2

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

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/

Réponse 2 / 2

Guitou

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 :)

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

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.........

Guitou > f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention

Re,

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

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713 > Guitou

Re,

Mais modifier mon code
Oui, lequel ?

Guitou > f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention

Celui qui est dans le fichier excel que j'ai un peu retouché :
*Voir les codes dans les modules aussi

Userform

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 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 Sub

Public 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

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713 > Guitou

Bonjour,

Mettez votre fichier a dispo si vous voulez, mais vous ne pouvez pas avoir d'icone avec ce code, pourtant pas complique a comprendre

Discussions similaires

c est quoi un ID

Avis iPhone sans Face ID

Activation d'une carte SIM

Activer ma carte SIM lycamobile

piratage compte facebook

Votre réponse

Discussions similaires