Autres toutes versions tester le scrool avec la roulette sans passer par un hooking en addressof

[patricktoulon]

Bonjour a tous
la principal raison des crash excel quand on utilise le hooking de la souris pour avoir le mouse wheel(la roulette)
c'est que le looping avec le (CallnextHook)est asynchrone avec le captage du message de la souris
donc quand une erreur se produit(on va trop vite ou autre)
le looping lui continue parfois au moins une fois même en erreur
résultat comme on déplace le block type du message en mémoire ça crash

je vous propose de tester ceci
ici on va rester dans un do/loop vba classique et le message de la souris sera récupéré par un peekmessage
si il y a une erreur (du au message de la souris non conforme) normalement on a une erreur vba classique
et donc le do/loop est interrompu
donc pas de relance avec un message de la souris erroné donc pas de crash
Vous constaterez que j'augmente l'allocation de la mémoire aussi (64 bits double (longlong ou longPtr))(+2&)

d'autant plus que la dans cette démo je met tout dans le userform
ce qui n'est pas possible avec un code de hooking bien entendu
et ça peut avoir un avantage lorsque l'on veut distribuer un interface(userform) sans devoir l'accompagner de x modules

toujours pareil pour déterminer le rectangle je me sert de ma fonction perso du calendar que j'ai modifié pour ce besoins
donc testez et si ça fonctionne je ferais une ressource au propre

merci d'avance pour votre participation

j'en connais un qui vas ouvrir grand les yeux 🤣

Patrick

 

[patricktoulon]

Bonjour, j'ai décidemment des comportements étranges avec vos codes 🙂🙂

@Nathe :il est clair dans ta capture que ta carte graphique a du mal a suivre pour le rafraichissement
@jurassic pork : a tu essayé le post #83

 

[ChTi160]

Re
Nathe
pourquoi ta ListBox n'a t'elle pas de scrollBar ?
Jean marie

 

[jurassic pork]

@jurassic pork : a tu essayé le post #83

Non car je n'arrive plus à suivre la discussion, il y a plein de messages en rafale, mais je vais le faire sous différentes versions d'Excel.

 

[Nathe]

@Nathe :il est clair dans ta capture que ta carte graphique a du mal a suivre

Pour info carte graphique RTX3070, je pense que ça devrait fonctionner

 

[Nathe]

Re
Nathe
pourquoi ta ListBox n'a t'elle pas de scrollBar ?
Jean marie

Bonne question, je ne sais point

 

[jurassic pork]

Non car je n'arrive plus à suivre la discussion, il y a plein de messages en rafale, mais je vais le faire sous différentes versions d'Excel.

Bon le classeur du post #83 m'a l'air vraiment pas mal :
Je l'ai essayé sous
Excel 2021 64 bits Windows 11
Excel 2016 32 bits WIndows 11
Excel 2010 32 bits Windows 7 SP1
Pas d'erreurs , scroll fluide et bien blocage du scroll feuille pendant le scroll ComboBox.
Nathe as-tu essayé le classeur du Post #83 ? Quelle version d'Excel as-tu.

 

[Nathe]

Bon le classeur du post #83 m'a l'air vraiment pas mal :
Je l'ai essayé sous
Excel 2021 64 bits Windows 11
Excel 2016 32 bits WIndows 11
Excel 2010 32 bits Windows 7 SP1
Pas d'erreurs , scroll fluide et bien blocage du scroll feuille pendant le scroll ComboBox.
Nathe as-tu essayé le classeur du Post #83 ? Quelle version d'Excel as-tu.

oui, d'où la réponse du #85, sinon le reste va bien

Nom de l'OS
Version	Microsoft Windows 10 Professionnel
Architecture	64 bits
Version	10.0.19045
Version Excel & VBA
Version	Excel 2016, 2019 ou Office 365 (16.0)
Build	Build 18526
Architecture	32 bits
Version de VBA	7,01

 

[jurassic pork]

oui, d'où la réponse du #85, sinon le reste va bien

arf encore une réponse que j'avais ratée.
On dirait que tu as un effet de zoom sur la ListBox. Tu n'as pas le zoom "cablé" sur la roulette souris ?

 

[Nathe]

Euuuuuuuuh je sais pas

 

[jurassic pork]

Euuuuuuuuh je sais pas

C'est pas grave car je viens de voir que Chti160 avait eu le même problème et qu'il l'avait résolu en redimensionnant la listbox. Cela a fonctionné pour toi ?

 

[Nathe]

C'est pas grave car je viens de voir que Chti160 avait eu le même problème et qu'il l'avait résolu en redimensionnant la listbox. Cela a fonctionné pour toi ?

oui le faite de juste redimensionner un chouia ça fonctionne bien

 

[patricktoulon]

alors c'est bon ou c'est pas bon
donnez moi ce que vous avez fait pour ce problème de zoom comme ça je l'intègre au cas ou

@jurassic pork tu a vu comme c'est vraiment fluide on ressent plus les saccades dans les rappels

 

[jurassic pork]

alors c'est bon ou c'est pas bon
donnez moi ce que vous avez fait pour ce problème de zoom comme ça je l'intègre au cas ou

Ben en fait Nathe n'avait pas de scroll vertical sur sa Listbox (ce qui est louche) et donc la roulette faisait le zoom au lieu du scroll.

@jurassic pork tu a vu comme c'est vraiment fluide on ressent plus les saccades dans les rappels

oui mais j'ai des PCs assez rapides il faudrait voir avec quelqu'un qui a un pc lent.

 

[ChTi160]

Re
J'ai aussi en plus des objets présents dans le fichier test . Crée mes propres objets (car des fois .....) et tout fonctionne correctement .
Merci a vous
Bonne fin de journée
Jean marie

 

[patricktoulon]

re
j'ai ajouter le resize null au cas ou

'ici on capte le message de la souris  et selon le messgae on appelle la sub scroller qui gère toute les sorte de control
Sub MouseWheelOut(control As Object, Optional pilote As Object = Nothing)
    Const WHEEL_DELTA = 120&, WM_MOUSEWHEEL = &H20A, PM_NOREMOVE = &H0&
    Dim tMsg As Msg, lDelta As Integer, criter As Boolean, A
    Dim PosControl As IAccessible
    criter = IsScrollable(control) 'on controle si on est bon pour scroller (permet de pouvoir atteindre le dropbutton de la combo)
    If Not criter Or bLooping Then Exit Sub
    If Not TypeOf control Is UserForm Then
        If TypeName(control.Parent) = "Worksheet" Then
            ActiveSheet.ScrollArea = control.TopLeftCell.Offset(1).Address 'bloque le scrollarea de la feuille a la cellule la plus proche du control( EVITE LES PETITS SURSAUTS)
            control.Height = control.Height + 10: control.Height = control.Height - 10
        End If
    End If
    Do
        criter = IsScrollable(control)
        If Not criter Then
            bLooping = False
            If Not TypeOf control Is UserForm Then If TypeName(control.Parent) = "Worksheet" Then ActiveSheet.ScrollArea = "" 'debloque le scrollarea de la feuille
            If Not TypeOf control Is UserForm Then If TypeName(control.Parent) = "Worksheet" Then control.TopLeftCell.Offset(1).Select 'la selection provoque le replis de la combo
            Exit Sub
        End If
        bLooping = True
        Call WaitMessage
        If PeekMessage(tMsg, NULL_PTR, WM_MOUSEWHEEL, WM_MOUSEWHEEL, PM_NOREMOVE) Then
            lDelta = HiWord(tMsg.wParam)
            Scroller lDelta, control, pilote
        End If 'End of PeekMessage
        DoEvents
    Loop While criter
End Sub

je suis en train de regarder mon pc portable il semblerais que ce soit pas la crte mère comme je croyais mais une barrete memoire mal enfiché
je nettoyer toute les broches et essayer de le redémarrer
vu l’état du machin je crois que l'on pourra pas faire moins puissant
moins puissant c'est un boulier chinois 🤣 🤣 🤣 🤣 🤣
punaise 18 ans le machin