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

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

patricktoulon

XLDnaute Barbatruc
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
 

Pièces jointes

Solution
Bonjour @jurassic pork , @Dudu2 , @Nathe
j'ai mis le controlrelease en optionnel dans la démo (fonctionne aussi dans userform)
j'en ai profité pour mettre un multipage
et dans la page 1 du multipage j'ai mi un label violet
et c'est lui qui pilote le scroll de la page
comme ca on peut mettre un fond sur chaque page vu que ce control n'a pas de propertie backcolor
bien évidemment j'ai ajouté le textbox
dans cette démo donc on a le controlrelease optionnel
et le scroll piloté par un autre control
voila comme ça on est au même niveau que la V 3.0 avec iaccessible (All control working)

patrick
@jurassic pork, @patricktoulon

Remarques sur la captation de IUIAElement d'un Control.
  1. En ActiveX ou UserForm ComboBox on récupère toujours la ComboBox Main même si la ComboBox est Drop Down
  2. En ActiveX TextBox il faut impérativement activer la TextBox pour que l'UIAutomation ne se plante pas
  3. En Control UserForm je n'arrive pas à récupérer le Handle du Control
Et bonne nouvelle, mon Desktop est réparé ! Je vais aller le chercher.
 

Pièces jointes

re
je pige pas trop ce que tu dit avec combobox main etc... tu parles sans doute d'une de tes fonctions

mais l'iaccssible renvoie le role 33 quand c'est developpé
et cela que le x,y soit dans l'input sur le boutondropp ou dans la scrollbar ou dans la liste developpé
donc tant que c'est pas 33 pour la listbox ou combobox on scroll pas

parti de la je comprend pas trop ce que tu va chercher
quand tu sort de la combo l'iaccessible tombe sur la feuille ou autre chose donc ce n'est plus le role 33 donc sortie

dans mon exemple version minimale je le montre bien

VB:
Function IsScrollable(control As Object) As Boolean
    Dim PosControl As IAccessible, pos As POINTAPI, ok As Boolean, role, Q&, obj
    Select Case True
        Case TypeOf control Is ComboBox: role = 33
        Case TypeName(control) = "ListBox": role = 33
        Case TypeName(control) = "Frame": role = 20
    End Select
    GetCursorPos pos

    'pour sortir en cas de control non géré  qui n'appelerait donc pas la mouseWheel quand on est dans une feuille
    'Set obj = ActiveWindow.RangeFromPoint(pos.X, pos.Y)
    'If Not TypeName(obj) = "Range" Then If obj.Name <> control.Name Then IsScrollable = False: Exit Function


re:
    #If Win64 Then
        Dim lngPtr As LongPtr
        CopyMemory lngPtr, pos, LenB(pos)
        AccessibleObjectFromPoint lngPtr, PosControl, 0
        CopyMemory lngPtr, 0, LenB(pos)
    #Else
        AccessibleObjectFromPoint pos.X, pos.Y, PosControl, 0
    #End If
    
    'rattrapage pour choper la combo developpée
    If PosControl.accRole <> role Then
        If TypeOf control Is ComboBox And Q = 0 Then Q = 1: pos.Y = pos.Y + 25: GoTo re
    End If
    
    On Error Resume Next
    [c1] = PosControl.accRole
    IsScrollable = PosControl.accRole = role
End Function
demo1.gif
 
patricktoulon et Dudu2 vous avez essayé mon classeur du Post #295 ? Comme il y a souvent un problème de double affichage sur les listbox entre vos deux configurations, pour savoir si avec ce classeur vous avez des soucis avec ce classeur normalement plus universel . Il peut y avoir le problème cité dans le post #295 mais facilement rectifiable.
 
re
c'est la combobox qui est bien particulière
quand on bouge dessus (non développée) elle te donne le role 10(celui de la feuille)
quand on bouge dessus (developpé) partout elle te donne 33 (dans l'input , le dropbutton, sa scrollbar, la liste)

donc quand j'envoie la mousewheel je lance la isscrollable et je test 2 points
x,y et x,y+25
si x,y me donne 10 elle est PRETENDUMENT REPLIEE
SI X,Y+25 me donne 33 alors elle est DEVELOPPEE donc scrollable
et comme le do/loop est lancé elle tourne dans que 33
si ca donne toujours 10 ben on fait rien on sort isscrollable=false

donc avec mon repeat iaccessiblefrompoint(répété qu'une fois) je peux me balader dessus sans lancer le do/loop
et dès que je vais cliquer sur le dropbutton le role va devenir 33 et lancer le do/loop
ou 10 si je reclique et donc arrêter

c'est aussi simple que ça

après la sortie si control non géré j'ai le rangefrompoint pour la feuille et le uiauto pour l'userform dans la version de la ressource
disponible des que modération

cette version de base ne gère que les listbox combobox et frame mais on peut ajouter les case dans le select case dans isscrollable et scrolling c'est tout

pas la peine de usiner avec IAccessible
surtout que le accessibleobjectfrompoint identifie bien tout les controls par le accRole

je sais pas si tu te rends compte avec ton windowfrompoint a chercher le rectangle d'un textbox
alors que dans isscrollable et scrolling en a joutant le case typeof control is TextBox:role=42 tu la tout de suite
la version déposée gère tout les controls même les les label si on voulais s'en servir pour scroller un autre control ou faire un on/of avec la roulette

bref c'est d'une simplicité bluffante

 
patricktoulon et Dudu2 vous avez essayé mon classeur du Post #295 ? Comme il y a souvent un problème de double affichage sur les listbox entre vos deux configurations, pour savoir si avec ce classeur vous avez des soucis avec ce classeur normalement plus universel . Il peut y avoir le problème cité dans le post #295 mais facilement rectifiable.
ben c'est ma version 2 ça tu a changé quoi? je vois pas dans le code
bon en tout cas les listbox sont doublées mais il fonctionne le scroll

c'est malheureusement peut être un problème entre le 64/32 tout simplement qui n'a pour l'instant pas de solution
un peu comme quand je prends un fichier sur le net et qu'il y a un listview que je suis obligé de remplacer purement et simplement
 
ben c'est ma version 2 ça tu a changé quoi? je vois pas dans le code
bon en tout cas les listbox sont doublées mais il fonctionne le scroll
oui c'est ta version 2 . J'ai ajouté une valeur dans la largeur de colonne des ListBox.
C'est bizarre que tu me dises que ça fait double affichage parce que j'ai testé le classeur avec une configuration qui ressemble à la tienne :
Excel 2013 sous windows 10 . Quelle résolution d'écran et quelle mise à l'échelle as-tu ? et peux-tu montrer ton double affichage ?
Si c'est celui que j'ai décrit dans le Post #295 , c'est normal je l'ai eu aussi dans le Excel 2013 . Il suffit d'enregistrer le fichier , de le fermer et de le rouvrir pour que le double affichage disparaisse. Le plus grave des double affichages était celui causé par l'absence de valeur pour la largeur des colonnes des ListBox.
 
Dernière édition:
@jurassic pork
patricktoulon et Dudu2 vous avez essayé mon classeur du Post #295 ?
Pas de problème d'affichage. Pas de "grosses" ListBoxes comme dans le fichier original de @patricktoulon.

@patricktoulon,
J'essaie juste de fabriquer des fonctions qui donnent le RECT des Controls et éventuellement leur Handle.
Ça n'a plus rien à voir avec le Scroll, c'est juste l'utilisation de lUIAutomation guidée par @jurassic pork.
La récupération du Handle pour les Controls de UserForm ne marche pas.

Tu parles des accRoles 10 et 33. C'est pour une ComboBox ActiveX ou UserForm ou les 2 ?
Ceci dot pour tester si la ComboBox est développée ou pas il suffit de tester sont TopIndex (-1 ou 0-n).
 
re
non @Dudu2 sur 2013 pro plus 32 bits uiauto getboundingrectangle donne une farce avec les controls sur feuille
c'est bien pour ca que dans V 2 il y a la condition Onsheet

d'ailleurs j'ai changé la méthode
j'ai virer rangefrompoint qui etait correcte mais rendait moins fluide le scroll
maintenant je stoc le rect sous forme d'array a chaque changement de controle et je compare avec pos
l'array est vidé en sortie

et voila hyper véloce
 
9 minute pas plus
Pour afficher ce contenu, nous aurons besoin de votre consentement pour définir des cookies tiers.
Pour plus d'informations, consultez notre page sur les cookies.
c'est hyper simple j'ai repris mon module de base adapter a la feuille
pour ajouter des controls ajouter dans les select cases de isScrollable et Scrolling
Terminé
alors vous le voulez ce module ou pas
 
j'ai un doute on va faire un test @jurassic pork
si c'est comme cijoint.com qui fraccasse les fichiers excel
renvoie moi le dans un zip
Patricktoulon ce que tu me montres dans ta capture est ce que j'ai eu aussi avec le Excel 2013 c'est celui que je montre dans le Post #295. Celui là il est pas dangereux car il se résout en enregistrant le fichier, le fermant et le réouvrant. C'est sûr qu'avec des activeX qui datent de Mathusalem on va se chopper de plus en plus de bugs dans les O.S modernes
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

P
Réponses
1
Affichages
834
P
Retour