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

[Nicolas JACQUIN]

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

 

[patricktoulon]

bon ben moi j'ai presque résolu mon soucis il me manque que le bas
c’était le bas qui me fait le boxon
mais bon je suis sur d'être on great way
et contrairement à toi je n'ai pas besoins de tester feuille userform pan et tout la ribambelle
je ne teste que le rectangle du control
allez aide moi a pigé ce qui va pas avec ce And pos.Y<a(3)

elle est bien ma fonction placement uf je la roule à toute les sauces

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)
    verifPosition CheckBox1
End Sub

Private Sub CheckBox2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
     verifPosition CheckBox2
End Sub

Private Sub CheckBox3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
     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
    With commentaire:
        .Visible = True
        .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.9: GetCursorPos pos: DoEvents
        criter = (pos.X > a(0) And pos.X < a(2))
        criter = criter And pos.Y > a(1)    'And pos.Y < a(3)
        If criter <> True Then Debug.Print a(0) & " - " & pos.X & " - -" & criter: commentaire.Visible = False: Exit Do
: Loop
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

 

[patricktoulon]

le fichier
débloque la 4 me condition ça clignote je sais pas pourquoi

 

[patricktoulon]

comme tu peux le voir ca fonctionne pour le haut la gauche la droite mais dès que je met le bas ca déraille

 

[Nicolas JACQUIN]

Re Patrick, je suis perdu là, si tu as une idée par rapport à ce que j'ai pondu, tu pourra me dire.
Merci

 

[patricktoulon]

punaise!!!!!!!!!
c'est moi qui fait des sauttises * a la place de diviser pour le coeff pixel voila maintenant ça marche

Sub verifPosition(check As Object)
    a = emplacementControl(check)
    Dim pos As pointapi
    With commentaire:
        .Visible = True
        .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.9: GetCursorPos pos: DoEvents
        criter = (pos.X > a(0) And pos.X < a(2))
        criter = criter And pos.Y > a(1) And pos.Y < a(3)
        Debug.Print pos.Y < a(3)
        If criter <> True Then Debug.Print a(0) & " - " & pos.X & " - -" & criter: commentaire.Visible = False: Exit Do
: Loop
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

voilà comme tu vois pas besoins de faire une usine
juste déterminé le rectangle de l'object
et dans le do loop que je peux réduire a peau de chagrin si pos. et pos.y ne sont pas dans le rectangle bybye le move sur l'object relance le truc si on bouge pas ben le do loop tourne qu'une fois et s’arrête avec le commentaire visible
économique en plus de ça

 

[patricktoulon]

Re Patrick, je suis perdu là, si tu as une idée par rapport à ce que j'ai pondu, tu pourra me dire.
Merci

@Nicos
@Dudu2 et moi te faisons 2 propos différentes tu aura l’embarras du choix

 

[Nicolas JACQUIN]

Pas trop compliqué , pour une fois que j'avais compris

 

[Nicolas JACQUIN]

J'ai fait un label transparent en périphérie des checkbox, du coup des que je sors, le com est effacé.
C'est peut-être boiteux pour vous mais ça match

 

[Nicolas JACQUIN]

 

[patricktoulon]

oui c'est la méthode que je t'ai proposé plus haut

et la je te propose une autre solution plus précise

et pour info vous avez suivi quand la modé aura modéré regardez ce qui vous attend avec le vba Indenter interface

 

[Dudu2]

@Nicos, comme je l'ai fait remarqué à @patricktoulon au début de ses posts, que ce soit des labels transparents créés en bordures dont tu testes le MouseMove() pour effacer le pop-up ou absolument rien du tout, c'est à dire le UserForm dont tu aurais testé le MouseMove() comme l'a indiqué @Valtrase au tout début, c'est, à mon avis, la même chose.
Mais peu importe l'essentiel c'est qu'au final, ça fasse ce que tu veux.

 

[patricktoulon]

re
@Dudu2 tu a testé mon fichier ?

 

[Dudu2]

J'ai testé celui du Post #40. Mais chez moi ça ne donne rien de bon.

 

[Nicolas JACQUIN]

J'ai testé celui du Post #40. Mais chez moi ça ne donne rien de bon.

Chez moi ca fonctionne, mais il a pas du voir mon poste précédant, je reste pour l'instant pareil

 

[fanch55]

J'ai testé celui du Post #40. Mais chez moi ça ne donne rien de bon.

J'ai testé, cela fonctionne comme attendu sur mon excel 2021 :