XL 2021 Commentaire au survol d'un checkbox d'un userform

Nicolas JACQUIN

Nicolas JACQUIN

XLDnaute Impliqué
Supporter XLD
Bonjour à tous,

Comme le titre le dit, je cherche à mettre un commentaire ou note au survol d'un checkbox d'un userform,
je sais que ça se fait et qui en a qui savent faire, mais plus moyen de trouver.

Merci d'avance à tous
 
Solution
Nicolas JACQUIN
Bonjour tous le monde,
J'ai trouvé ma solution je pense

Dans un module

VB: 
Public Const MyString1 = "Les 1"
Public Const MyString2 = "Les 2"
Public Const MyString3 = "Les 3"
Public Const MyString4 = "Les 4"

Et dans le userform

Code: 
Private Sub CheckBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    commentary CheckBox1, vbCrLf & MyString1
End Sub

Private Sub CheckBox2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    commentary CheckBox2, vbCrLf & MyString2
End Sub

Private Sub CheckBox3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    commentary CheckBox3, vbCrLf & MyString3...
Trier par date Trier par votes
Dudu2

Dudu2

XLDnaute Barbatruc
Bonjour @patricktoulon,
D'une part il te faut de l'espace pour ces "sur-Controls" qu'il faut en plus créer.
Je vois pas l'avantage par rapport au UserForm_MouseMove() (ou Parent_MouseMove()) car l'espace réservé à ces "sur-Controls" peut très bien être celui du UserForm (ou du Parent).

D'autre part, si tu passes trop vite la souris, tu as le même problème qu'avec le UserForm_MouseMove(). D'autant plus probable que les débordements des "sur-Controls" sont fins. Le MouseMove du "sur-Control" n'a pas le temps de se déclencher.
Ce qui se voit très bien dans l'extrait de ton propre GIF ci-dessous où en sortant, le label reste affiché.

Vite.gif

Donc cette "astuce vielle comme le monde" a un problème vieux comme le monde.

Edit: De toutes façons, perso si je devais l'implémenter, j'utiliserais la fonction du Post #9 dont je devrais d'ailleurs faire une ressource. Certes il faut ajouter un module (pré-fabriqué tel quel), mais rien à créer en plus du Label dynamique, pas le souci de savoir qui est le Parent, et code simplifié dans le UserForm (pas de flags à gérer, pas d'utilisation d'autre évènement que le MouseMove() du Control concerné). Et, cerise sur le gâteau, ça fonctionne sans restriction.
 
Dernière édition:
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
Bonjour @Dudu2
dans ce cas là il faut gérer tout les event mose move de tout les eventuels parent donc comme je disais classe

rien ne t'empêche de mettre le label calque a la dimension de tout l'userform
VB: 
calquetrans.Move 0, 0, Me.InsideWidth, Me.InsideHeight
pour info si l'option classe est choisie le problème du mouvement trop rapide reste entier si le control est trop pres d'un bord ou pas assez grand et ne dépasse pas assez autour de lui il faut alors classer aussi l'userform pour son move
et pire encore si le control est au bord de l'userform là c'est MORT !!
donc tu vois classe ou pas le problème reste entier
il faut alors ajouter une fonction on time qui gèrerait eventuellement un raté
mais on est là dans un truc de fou pour un besoins pareil
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
truc c'est pour éviter de faire 1000 fois un move si on reste sur un control
on évite ainsi les scintillements
Code: 
Dim truc As Object

Private Sub CheckBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    commentary CheckBox1, "turlututu " & vbCrLf & " chapeau pointu" & vbCrLf & "vive les casquettes"
End Sub

Private Sub CheckBox2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    commentary CheckBox2, "oui lui aussi  " & vbCrLf & "il a droit a" & vbCrLf & "son commentaire"
End Sub

Private Sub CheckBox3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    commentary CheckBox3, "blablabla " & vbCrLf & " blablabla" & vbCrLf & "blablabla"
End Sub

Private Sub calquetrans_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    calquetrans.Visible = False: commentaire.Visible = False
Set truc = Nothing
 End Sub
Private Sub commentaire_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    calquetrans.Visible = False: commentaire.Visible = False
Set truc = Nothing
End Sub
Sub commentary(check, comm)
   If truc Is Nothing Then
   calquetrans.Visible = True
    calquetrans.ZOrder 1
    commentaire.Visible = True
    With check
        calquetrans.Move 0, 0, Me.InsideWidth, Me.InsideHeight
        commentaire.Move check.Left + check.Width - 5, check.Top - commentaire.Height - 5
        commentaire.Caption = check.Name & vbCrLf & comm
   If commentaire.Top < 0 Then commentaire.Top = 0
   If commentaire.Left + commentaire.Width > Me.InsideWidth Then commentaire.Left = Me.InsideWidth - commentaire.Width
   Set truc = check
  
   End With
End If
End Sub
 
Vote positif 0 Vote négatif
Nicolas JACQUIN

Nicolas JACQUIN

XLDnaute Impliqué
Supporter XLD
Bonjour tous le monde,
J'ai trouvé ma solution je pense

Dans un module

VB: 
Public Const MyString1 = "Les 1"
Public Const MyString2 = "Les 2"
Public Const MyString3 = "Les 3"
Public Const MyString4 = "Les 4"

Et dans le userform

Code: 
Private Sub CheckBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    commentary CheckBox1, vbCrLf & MyString1
End Sub

Private Sub CheckBox2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    commentary CheckBox2, vbCrLf & MyString2
End Sub

Private Sub CheckBox3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    commentary CheckBox3, vbCrLf & MyString3
End Sub

Private Sub CheckBox3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    commentary CheckBox3, vbCrLf & MyString4
End Sub

Sub commentary(check, comm)
    commentaire.Visible = True
    With check
        commentaire.Caption = .Caption & ":" & "" & vbCrLf & comm
        commentaire.AutoSize = True: commentaire.Width = 110
        commentaire.Left = .Left + .Width + 15: commentaire.Top = .Top
    End With
End Sub
End Sub


Merci à tous
test form4.gif
 
Dernière édition:
Vote positif 0 Vote négatif
Solution
Nicolas JACQUIN

Nicolas JACQUIN

XLDnaute Impliqué
Supporter XLD
Salut Patrick, merci de me répondre ;)

Ma petite version, je me suis inspiré de la tienne mais à ma façon, parce que les coms suivent pas le bord droit des checkbox, c'est pour ça du coup que j'ai mi le panneau coms fixe sur le coté droit, mais là c'était juste vite fait pour montrer.
Mais ça me va bien comme ça quand même

test form2.gif
 
Vote positif 0 Vote négatif
Dudu2

Dudu2

XLDnaute Barbatruc
rien ne t'empêche de mettre le label calque a la dimension de tout l'userform
Cliquez pour agrandir...
Oui j'y ai pensé en lisant ton post. Mais ça ne change rien au problème des Controls en limite de UserForm où de toutes façons, la bordure du Control est trop proche de celle du UserForm ou du calque qui le recouvre pour garantir le déclenchement du MouseMove, ainsi que tu le dis toi-même:
et pire encore si le control est au bord de l'userform là c'est MORT !!
Cliquez pour agrandir...
Et je suis bien d'accord là-dessus:
donc tu vois classe ou pas le problème reste entier
il faut alors ajouter une fonction on time qui gèrerait eventuellement un raté
mais on est là dans un truc de fou pour un besoins pareil
Cliquez pour agrandir...
C'est pourquoi la solution du Post #9 reste la seule qui soit réellement fonctionnelle. Même si elle n'intéresse personne
1715330597089.gif
!
 
Vote positif 0 Vote négatif
Valtrase

Valtrase

XLDnaute Occasionnel
Bonjour à tous
Un autre solution simple est d'obliger à tester la position du curseur :
VB: 
Private Sub CheckBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    With CheckBox1
            If X > 2 And X < .Width - 2 And Y > 2 And Y < .Height - 2 Then
                With Label1
                    .Top = CheckBox1.Top + CheckBox1.Height
                    .Left = CheckBox1.Left + CheckBox1.Width
                    .Caption = CheckBox1.Tag
                    .Visible = True
                End With
            Else
                Label1.Visible = False
            End If
    End With
End Sub
Le commentaire sera dans le .Tag des CheckBox.
 
Vote positif 0 Vote négatif
Dudu2

Dudu2

XLDnaute Barbatruc
@Valtrase,
C'est une bonne idée mais ça ne résout pas le problème du glissement rapide de la souris.
Il y a 2 points de marge et ne suffit pas pour garantir l'exécution du MouseMove().
VB: 
Private Sub CheckBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
    With Me.CheckBox1
        If x > 2 And x < .Width - 2 And Y > 2 And Y < .Height - 2 Then
            Me.Controls(LabelName).Visible = True
        Else
            Me.Controls(LabelName).Visible = False
        End If
    End With
End Sub

Vite2.gif
 
Dernière édition:
Vote positif 0 Vote négatif
Valtrase

Valtrase

XLDnaute Occasionnel
Re,
Peut-être que cela dépend de la vélocité du PC : Sur le mien I7 16Go je n'ai aucun problème.
VB: 
Option Explicit

Private Sub CheckBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    With CheckBox1
        If X > 2 And X < .Width - 2 And Y > 2 And Y < .Height - 2 Then
            Label1.Width = 500
            Label1.Caption = .Tag
            Label1.AutoSize = True
            Label1.Top = .Top + .Height
            Label1.Left = .Left + .Width
            Label1.Visible = True
            Label1.AutoSize = False
        End If
    End With
End Sub

Private Sub CheckBox2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    With CheckBox2
        If X > 2 And X < .Width - 2 And Y > 2 And Y < .Height - 2 Then
            Label1.Width = 500
            Label1.Caption = .Tag
            Label1.AutoSize = True
            Label1.Top = .Top + .Height
            Label1.Left = .Left + .Width
            Label1.Visible = True
            Label1.AutoSize = False
        End If
    End With
End Sub

Private Sub CheckBox3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    With CheckBox3
        If X > 2 And X < .Width - 2 And Y > 2 And Y < .Height - 2 Then
            Label1.Width = 500
            Label1.Caption = .Tag
            Label1.AutoSize = True
            Label1.Top = .Top + .Height
            Label1.Left = .Left + .Width
            Label1.Visible = True
            Label1.AutoSize = False
        End If
    End With
End Sub

Private Sub CheckBox4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    With CheckBox4
        If X > 2 And X < .Width - 2 And Y > 2 And Y < .Height - 2 Then
            Label1.Width = 500
            Label1.Caption = .Tag
            Label1.AutoSize = True
            Label1.Top = .Top + .Height
            Label1.Left = .Left + .Width
            Label1.Visible = True
            Label1.AutoSize = False
        End If
    End With
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label1.Visible = False
End Sub
 
Vote positif 0 Vote négatif
Nicolas JACQUIN

Nicolas JACQUIN

XLDnaute Impliqué
Supporter XLD
Voici ma version du post #19 modifiée qui me va bien (pas trop de ligne et compréhensif pour moi) ;)

VB: 
Private Sub CheckBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    commentary CheckBox1, vbCrLf & MyString1
End Sub

Private Sub CheckBox2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    commentary CheckBox2, vbCrLf & MyString2
End Sub

Private Sub CheckBox3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    commentary CheckBox3, vbCrLf & MyString3
End Sub

Private Sub CheckBox4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    commentary CheckBox4, vbCrLf & MyString4
End Sub

Private Sub CheckBox5_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    commentary CheckBox5, vbCrLf & MyString5
End Sub

Sub commentary(check, comm)
    commentaire.Visible = True
    With check
        commentaire.Caption = .Caption & ":" & "" & vbCrLf & comm
        commentaire.AutoSize = True: commentaire.Width = 110
        commentaire.Left = .Left + .Width + 20: commentaire.Top = .Top
    End With
End Sub

Private Sub UserForm_Initialize()
commentaire.Visible = False
End Sub

Un dernier truc, quand il n'y a plus de survol de chekbox, comment effacer le com ?
Merci encore à tous
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
j'ai vu ton truc @Dudu2 comme d'hab avec ta manière de coder à rallonge avec passerelle sur passerelle j'en pige pas une miette
il y a longtemps que j'ai abandonné d'essayer de comprendre tes codes 😂 😂
cela dit ça a l'air de fonctionner
perso j'ai pris une autre approche
j'ai récupéré ma sub pacementobjUF dans mon calendar et j'ai remanier en fonction
qui me renvoie left top right et bottom
par contre il y a un truc que je ne saisi pas
a aucun moment je lui demande de se cacher a part après le delay du do/doevents/loop
si la position de la souris et en dehors de ce rectangle
et pourtant si je reste dessus sans bouger il fini par disparaitre
je me casse la tête depuis tout à l'heure avec ça
VB: 
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As pointapi) As Long
Private Type pointapi: x As Long: y As Long: End Type

Dim pos As pointapi

Private Sub CheckBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    commentaire.Visible = True
    verifPosition CheckBox1
End Sub

Private Sub CheckBox2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    commentaire.Visible = True
    verifPosition CheckBox2
End Sub

Private Sub CheckBox3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    commentaire.Visible = True
    verifPosition CheckBox3
End Sub

Private Sub commentaire_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    commentaire.Visible = False
End Sub

Sub verifPosition(check As Object)
    a = emplacementControl(check)
    Dim pos As pointapi
  GetCursorPos pos
   With commentaire: .Move check.Left + check.Width, check.top - .Height
        If .top < 0 Then .top = 0
        If .Left > Me.InsideWidth - .Width Then .Left = Me.InsideWidth - .Width
    End With
      tim = timer: Do While timer - tim < 0.1: DoEvents: Loop
    criter = pos.x > a(0) And (pos.x < a(2)) And (pos.y > a(1) And pos.y < a(3))
    If Not criter Then Debug.Print a(2) & " - " & pos.x: commentaire.Visible = False: oldcontrol = "":
End Sub

' fonction du calendar reconvertie
Function emplacementControl(Obj As Object)
    If Not Obj Is Nothing Then
        Dim Lft As Double, Ltop As Double, P As Object, PInsWidth As Double, PInsHeight As Double
        Dim K As Double
        Lft = Obj.Left: Ltop = Obj.top: Set P = Obj.Parent    ' Normalement Page, Frame ou UserForm
        ppx = 0.75
        Do
            PInsWidth = P.InsideWidth: PInsHeight = P.InsideHeight    ' Le Page en est pourvu, mais pas le Multipage.
            If TypeOf P Is MSForms.Page Then Set P = P.Parent    ' Prend le Multipage, car le Page est sans positionnement.
            K = (P.Width - PInsWidth) / 2: Lft = (Lft + P.Left + K): Ltop = (Ltop + P.top + P.Height - K - PInsHeight)
            If Not (TypeOf P Is MSForms.Frame Or TypeOf P Is MSForms.MultiPage) Then Exit Do
            Set P = P.Parent
        Loop
       a = Array(Lft / ppx, Ltop / ppx, (Lft + Obj.Width) / ppx, (Ltop + Obj.Height) * ppx)
       emplacementControl = a
    End If
End Function
 
Vote positif 0 Vote négatif
Dudu2

Dudu2

XLDnaute Barbatruc
j'ai vu ton truc @Dudu2 comme d'hab avec ta manière de coder à rallonge avec passerelle sur passerelle j'en pige pas une miette
Cliquez pour agrandir...
Oui, je sais on a des manières de faire assez différentes 😂.

D'ailleurs, partant du test du curseur souris sur un objet pour les besoins de ce sujet, j'ai étendu le bidule dont je ferai sans doute une ressource à 3 autres petites fonctions qui sont liées. L'intérêt est surtout que l'objet couvre une grande quantité... d'objets ! dont les positions et tailles doivent être récupérées de manière spécifique.

Toujours en globish par réflexe vu mon lointain passé de développeur dans une boîte anglosaxone...
VB: 
'====================================================================
'4 useful Mouse related functions:
'- MouseIsOverObject() to check if the Mouse Cursor is over an Object
'- PlaceMouseOverObject() to place the Mouse Cursor over an Object
'- MouseLeftClick() to left click the Mouse
'- MouseRightClick() to right click the Mouse
'
'The Object can be:
'- a Window
'- any Worksheet Object (Range, ActiveX Control, Shape)
'- a UserForm
'- any Control into a UserForm
'====================================================================
 

Pièces jointes

  • MouseOverObject.xlsm
    44.3 KB · Affichages: 2
Vote positif 0 Vote négatif

Discussions similaires

Angus HEYERDAHL
  • Question
Microsoft 365 Résolu : ListView avec Checkbox
2
Réponses
27
Affichages
717
Angus HEYERDAHL
Angus HEYERDAHL
F
  • Question
XL 2016 Affichage date dans les graphs : "ddd d juillet yy" !
Réponses
1
Affichages
393
crocrocro
C
N
  • Résolu(e)
Microsoft 365 Simplifier un code pour activer ou désactiver des CheckBox
6 7 8
Réponses
115
Affichages
3 K
ChTi160
ChTi160
jeff1494
  • Question
XL 2021 Ajout de zones dans un USF par VBA
2
Réponses
16
Affichages
190
jeff1494
jeff1494
eastwick
  • Question
XL 2016 formule pour taux d'évolution
Réponses
10
Affichages
291
eastwick
eastwick
L
  • Question
XL 2019 aligner textbox userform et valeur de cellule
Réponses
1
Affichages
357
fanfan38
fanfan38
C
  • Question
XL 2016 Automatiser et synthétiser les informations d'un tableau Excel d'un onglet 1 vers des onglets 2 et 3
Réponses
14
Affichages
284
chris63
C
N
  • Question
XL 2021 numérotation CheckBox
5 6 7
Réponses
90
Affichages
5 K
nano33320
N
T
  • Résolu(e)
XL 2021 Incompatibilité de type avec un userform
2
Réponses
19
Affichages
735
Bernard38
Bernard38
anthoYS
  • Résolu(e)
XL 2019 alimentation quotidienne : gestion/suivi d'un déficit calorique
2 3
Réponses
39
Affichages
2 K
Phil69970
Phil69970

Membres actuellement en ligne

13 membres et 85 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 127
Messages
2 116 507
Membres
112 765
dernier inscrit
SIDIANW