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]

re
sur mon pc portable W7 sp1 2013 normal 32 bits ca ne fonctionnait pas mais je sais pas si on peut le prendre comme référence vu qu'au bout de 2 minute il a commencer à fumer 🤪 🤣 🤪 🤣
incroyable il c'est allumé 2 heures pour démarrer, il a fallu changer la date et tout et tout mais il a démarré

 

[patricktoulon]

pour 2007 il va falloir résoudre le problème du mémoire insuffisante avec la version windowfrompoint
car j'ai pas l'impression que le iaccessible fonctionne bien sur 2007

 

[Dudu2]

Perso je laisse tomber 2007, car d'une part je n'ai rien pour le tester et d'autre part une version qui a maintenant 18 ans d'âge on peut faire l'impasse.

 

[patricktoulon]

@Dudu2 oui c'est vrai
a tu testé le #83 ?
si ça marche bien chez toi alors que l'on a souvent toi et moi des différences de fonctionnement on peut considérer que l'on tient le bon bout

 

[Dudu2]

Oui le 83 marche très bien pour le UserForm, c'est parfait.

 

[patricktoulon]

et la feuille ?
j'ai ajouté le multipage

 

[patricktoulon]

En tout cas merci a tout les participants
@jurassic pork co auteur de la dernière version avec moi
et tout les autres pour leur retours de tests
@Nain porte quoi
@mapomme
@cathodique
@Nathe
@Valtrase
@Phil69970
@Dudu2
@Piment
@Rheeem
👍 👍 👍 👍 👍 👍 👍
une belle synergie pour arriver a un truc enfin stable qui fonctionne partout (2010 à 2021)
2024 je pense qu'il ne devrait pas avoir de différence avec 2021

petit récapitulatif des config testées
Excel 2021 64 bits Windows 11
Excel 2016 32 bits WIndows 11
Excel 2010 32 bits Windows 7 SP1
Excel 2013 pro plus 32 bits WIndows 10
Excel 2016 64 bits WIndows 10

 

[ChTi160]

Re
aussi 365 32 windows 11 64 🧑‍🔧
Jean marie

 

[patricktoulon]

re
bonsoir jean marie 365 c'est pas la version d'excel c'est la version de la suite office
fichier/comptes/a propos d'excel

 

[ChTi160]

Re
donc j'ai quoi Lol ?
Jean marie

 

[patricktoulon]

re
2016 32 bits visiblement ou la version 2021 click&run 32 bits qui donne 16 .xx.xxx.xx aussi
c'est simple si il y a des fonctions de 2021 que tu n'a pas c'est bien un 2016 sinon c'est l'hybride 2021 clik&run

 

[jurassic pork]

Pour Excel 2007 j'ai déjà dit que cela ne pouvait pas marcher dans les feuilles car il n'y a pas la gestion des contrôles ActiveX dans le code VBA des feuilles. En ce qui concerne les formulaires il y a des corrections à faire :
1 - Il manque la déclaration de AccessibleObjectFromPoint pour VBA < 7 dans les déclarations d'API

#Else
    Private Const NULL_PTR = 0&
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
    Private Declare Function WaitMessage Lib "user32" () As Long
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Type Msg: hWnd As Long: message As Long: wParam As Long: lParam As Long: time As Long: pt As POINTAPI: End Type
    Private Declare Function GetDpiForWindow Lib "user32" (ByVal hWnd As Long) As Long
    Private Declare Function AccessibleObjectFromPoint Lib "Oleacc" (ByVal lX As Long, ByVal lY As Long, ppacc As IAccessible, pvarChild As Variant) As Long

une autre correction à faire ici ( ne pas mettre de #Else ) :

Function IsScrollable(control) As Boolean
    Dim PosControl As IAccessible, pos As POINTAPI, ok As Boolean, role
    Select Case True
        Case TypeName(control) = "ListBox": role = 33
        Case TypeOf control Is ComboBox: role = 33
        Case TypeOf control Is Frame: role = 20
        Case TypeOf control Is Image: role = 40
        Case TypeOf control Is UserForm: role = 16
        Case TypeOf control Is ScrollBar: role = 3
    End Select
    GetCursorPos pos
    #If Win64 Then
        Dim lngPtr As LongPtr
        CopyMemory lngPtr, pos, LenB(pos)
        AccessibleObjectFromPoint lngPtr, PosControl, 0
    #End If
    AccessibleObjectFromPoint pos.X, pos.Y, PosControl, 0

et aussi désactiver le code de feuille pour VBA < 7 :

#If VBA7 Then
Private Sub ComboBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If bLooping = False Then MouseWheelOut ComboBox1
End Sub

Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) '
 If bLooping = False Then MouseWheelOut ListBox1
End Sub
#End If

Voici ce que cela donne pour le formulaire dans Excel 2007 sous Windows 7 SP1 :

et pour simuler un PC lent : Mon Windows 7 SP1 est dans une virtualBox . En paramètre j'ai mis utilisation d'un seul core, 2 Go de RAM et 20% du CPU (mon CPU est à 2,9 GHz ce qui est donc équivalent à un CPU de 600 Mhz ) --> Pas de ralentissement dans le scroll.

 

[patricktoulon]

re
bonjour @jurassic pork

 #If Win64 Then
        Dim lngPtr As LongPtr
        CopyMemory lngPtr, pos, LenB(pos)
        AccessibleObjectFromPoint lngPtr, PosControl, 0
    #Else
        AccessibleObjectFromPoint pos.X, pos.Y, PosControl, 0
    #End If

avec le #else ca fonctionne aussi bien me semble t il le vb6 passera par le else puisqu'il est en 32

bien vu pour la déclaration manquante c'est certainement pour ça que ca n'a pas marcher sur mon pc portable fumant hier je ré essaierais dans la matinée quand je reviens

donc on a bien un truc véloce et qui fonctionne sur toutes version confondues (2007 à 2024)
et sans risque de crashs Excel ou de saturation d'appel provoquant l'erreur "memoire insuffisante"
les rappels sont bien gérés avec blooping et criter de facon a annuler des eventuels rappels non nécessaires
afin de laisser tourner tranquillement le do/loop

et surtout sans être une usine a gaz
patrick

 

[jurassic pork]

donc j'ai quoi Lol ?

Hello,
ben c'est marqué en clair dans ta pièce jointe : tu as Microsoft Excel 365 32 bits
Ami calmant, J.P

 

[ChTi160]

Bonjour J.P
donc :

Microsoft Excel 365

ça correspond à quoi , par rapport a Excel 20xx ?
Merci de ton retour
Bonne Journée
Jean marie