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

 

[Nicolas JACQUIN]

Mais tu n'as pas compris apparemment, pas grave.
Bonne soirée

 

[patricktoulon]

j'ai tres bien compris mais tu te trompe
d'autant plus que c'est même code plus précis au niveau de changement de control
donc sinon garde la méthode universelle avec un calque au moins tu n'a pas de code ou moins

 

[Dudu2]

Bonjour toulemond,
Désolé mon @patricktoulon, je ne veux pas te casser le moral, mais voilà les commentaires sur ton code à Timer sur lequel tu t'acharnes inutilement.

1 - Ce qui est dans le Else (la boucle Timer) va s'instancier autant de fois que l'évènement MouseMove() va être déclenché, et on sait qu'en déplacement curseur dans le Control, cet évènement est déclenché en rafale beaucoup plus vite qu'une fois toutes les demi-secondes qui est ton temps de boucle. Donc tu auras plusieurs instances en parallèle et n'en je vois pas le bénéfice. Ok c'est secondaire mais quand même pas très "clean".

2 - Ton Timer est limité à 0.5 secondes, donc au bout de 0.5 secondes tu ne testes plus rien. Et si on sort de la zone du Control rapidement sans déclencher de MouseMouve(), tu ne vois pas qu'on est sorti. Illustration dans ce GIF.

 

[Dudu2]

Tu peux garder ton code en modifiant ton système pour la boucle éternelle, fut-elle ponctuée d'un Sleep si ça te gène de n'avoir que le Doevents en 32 bits si ça sature ta CPU.

Sub InfoBulle(check As Object, msg)
    Static ControlActif As MSForms.Control
    Dim A, Criter, B
    Dim pos As pointapi

    If check Is ControlActif Then Exit Sub
 
    Set ControlActif = check
 
    A = EmplacementControl(check)
    B = EmplacementControl(check, 1)
'Debug.Print "verif"
    With commentaire
        .Visible = True
        .ZOrder 0
        .Controls("message").Caption = UCase(check.Name) & vbCrLf & msg
 
        .Move B(0) + check.Width, B(1) - .Height
        If .top < 0 Then .top = check.top + check.Height
        If .Left > Me.InsideWidth - .Width Then .Left = check.Left - .Width
    End With

    Do While True
        GetCursorPos pos
        Criter = pos.X > A(0) And pos.X < A(2) And pos.Y > A(1) And pos.Y < A(3)
        If Not Criter Then Exit Do
        DoEvents
        Sleep 100
    Loop

    On Error Resume Next
    commentaire.Visible = False
    Set ControlActif = Nothing
'Debug.Print "stop"
End Sub

 

[Dudu2]

Lorsqu'on ferme le UserForm avec Alt + F4, le code plante parce que le Control commentaire a disparu. Il faut un On Error avant.

 

[Nicolas JACQUIN]

Bonjour mon Patrick, je t'aprécie beaucoup, c'est pas pour t'emmerder, j'ai fait mon correctif que tu connais depuis le temps qu'on se connait (malgré que tu ne l'aime pas, et pourtant) ou écart si tu préfère, on sait assez bataillé la dessus voilà ce que ça donne en visuel, c'est un peu plus précis malgré les scintillements. ( c'était juste sur la précision visuelle que je te disais hier soir )

J'avais dit qu'il fallait que je me refasse une paire de jumelle, parce que j'en ai plus, mais y en a qu'il faudrait qu'il consulte aussi.
A plus tard pour ton retour

 

[patricktoulon]

@Dudu2
ce qui me gene c'est que ton do while true tourne tant que c'est ok
alors que trouver un moyen de l’arrêter au bout de 100ms environ mais pourvoir le relance (uniquement cette parti si control actif est le même autrement un goto ou gosub un truc du genre
résultat le même effect que le sleep sauf que je n'en ai pas besoins une api utilisé dans ce projet est bien suffisante sauf que tu excepte cette possibilité avec ta sorti exit en debut de fonction avec controlactif
il faut bien comprendre comment fonctionne excel en 32 et 64
ta boucle do while true me fait monter le proc a 95% et c'est normal c'est un phénomène bien connu

 

[patricktoulon]

pourquoi je veux ça :
et bien par ce que quand on reste sans bouger sur le control aucun appel est fait
donc au moindre mouvement ça relance la machine donc on doit pouvoir limiter la boucle do while a moins que true on a juste besoins du moment ou on sort

donc en gros il faudrait pouvoir appeler la fonction infobulle de deux façon
une si control actif <> conc on relance les mesure etc...
et une autre si control identique lancer que le do while avec limite
ça permettrais de reposer le procc

me comprenez vous mieux ?

 

[Nicolas JACQUIN]

Le processeur tire pas du tout, je comprends pas enfin pas chez moi.
Mais ça sintille

 

[Dudu2]

@particktoulon,
Je comprends ton souci, raison pour laquelle tu es parti sur des Timers.
Mais d'une part la boucle True avec un Sleep 100 ne consomme quasi-pas de CPU (chez moi EXCEL.EXE reste à 00% de CPU quand le commentaire est affiché, donc que ça boucle).
D'autre part, il n'y a aucun moyen sûr de relancer le check du Mouse Over si on l'arrête avant d'être sûr qu'on n'est plus en Mouse Over. A part une usine à gaz dans un Module avec SetTimer à relancer toutes les 100 ms (par exemple) ce qui revient strictement au même.

 

[patricktoulon]

@Nico tu es en 64 toi non?
@Dudu2
si je te dis que l'on peut l'arrêter sorti ou pas c'est qu'on peut
et pour le coup cette version devrait te plaire
car j'utilise une instruction que tu semble apprécier dans tes développement

Sub InfoBulle(check As Object, msg)
    Dim pos As pointapi, Criter, i&, sorti$
    Static A
    Static B
    If check.Name = OldControl Then

        GoSub passe
    Else
        OldControl = check.Name
        A = EmplacementControl(check)
        B = EmplacementControl(check, 1)

        With commentaire
            .Visible = True
            .ZOrder 0
            .Controls("message").Caption = UCase(check.Name) & vbCrLf & msg
            .Move B(0) + check.Width - 3, B(1) - .Height + 3
            If .top < 0 Then .top = check.top + check.Height
            If .Left > Me.InsideWidth - .Width Then .Left = check.Left - .Width
        End With
passe:

        Do While i < 200    ' c laisse largement le temps de capter la sortie
            i = i + 1
            sorti = "pas sorti"
            Label1.Caption = "boucle à démarré " & i & "  " & sorti
            GetCursorPos pos
            Criter = pos.X > A(0) And pos.X < A(2) And pos.Y > A(1) And pos.Y < A(3)
            If Not Criter Then OldControl = "": sorti = "sorti": commentaire.Visible = False: Exit Do
            DoEvents
        Loop
Label1.Caption = "boucle arrêtée " & i & "  " & sorti
          

    End If
    'Debug.Print "stop"
End Sub

 

[Dudu2]

C'est pareil ! Timer ou boucle limitée en nombre. Ça s'arrête à un moment donné et le phénomène du Post #108 se produit.

une instruction que tu semble apprécier

Tu parles du GoSub ?
Oui j'utilise assez souvent pour des micro-fonctions de quelques lignes car on reste dans la procédure et donc on bénéficie des variables de celle-ci, évitant d'avoir à les passer en arguments à des fonctions externes.
Ceci dit, dans les instructions de l'étiquette d'un Gosub, on doit en principe trouver un Return ! Sinon c'est comme un GoTo.

 

[Nicolas JACQUIN]

@Nico tu es en 64 toi non?

windows 64 et excel 32

 

[TooFatBoy]

Bonjour,

Ceci dit, dans les instructions de l'étiquette d'un Gosub, on doit en principe trouver un Return ! Sinon c'est comme un GoTo.

Alors là mon Dudu tu me fais faire un bon dans le temps de plus de 40 ans en arrière !

Je ne savais pas qu'il y avait un GoSub en VBA.
Merci pour cette découverte.

 

[patricktoulon]

alors vous avez des soucis de mémoire par ce que je l'ai testé de long en large
et aucune erreurs ou raté ne c'est produit
goto ou gosub tu a compris le principe
tu peux éventuellement augmenter mais bon dans tout les cas chez moi 2007 2013 et 2016 ça match
on voit bien dans la vidéo que si je bouge pas elle redémarre pas et que quand je re bouge elle redémarre a zero normal puisque je repasse par le DIM
il n'y a pas le problème du post #108 car là c'est syncro avec l'action du move