XL 2019 Molette Scroll sur ListBox

[gg13]

Bonjour,

Je commence un nouveau projet pour lequel je devrai utiliser des ListBox et ComboBox.
Ces listes seront longues et je voudrais utiliser le scroll de la molette plutôt que les ascenseurs.

Après renseignement sur le site j’ai voulu utiliser ce post :
Mouse Wheel Hook (faire défiler le contenu d'une combobox/listbox avec la roulette)

Je galère depuis 2 jours et malgré plusieurs essais je n’arrive pas à intégrer ces différentes macros, plusieurs messages d’erreurs ….
Je ne comprends pas tout.
Si vous pouvez m’aider un peu je vous remercie d’avance.

Je joins le fichier exemple avec les listBox .

GG13

 

[Dudu2]

Tant mieux si ça te convient.

Pas assez de connaissances VBA pour moi pour comprendre le tout.

A part le code du Hook récupéré sur Internet et modifié par mes soins pour vérifier la position du curseur sur la ListBox et continuer ou arrêter le Hooking, j'avoue que pour coder le MousIsOverListBox, je n'aurais pas pu le faire sans une expérience des imbrications des Controls dans un UserForm et une récente découverte sur les Marges des UserForms apportée par @patricktoulon avec l'utilisation d'une fonction de l'API du DWM.
Je m'étonne moi-même de voir à quel point c'est complexe pour faire un truc de base !

La gestion du Scroll en ComboBox est infiniment plus simple car les évènements ComboBox_Click() sont suffisants pour activer et désactiver le Hooking sans qu'il soit besoin de recourir à des subterfuges.

 

[Dudu2]

A titre de comparaison, le Scroll Souris en ComboBox, plus simple...
Avec un tout petit accro mineur dans le système, tolérable pour garder la simplicité: lorsqu'on quitte la ComboBox en déplaçant simplement la souris, le Scroll qui devrait revenir sur la feuille reste sur la Combo... jusqu'au prochain clic n'importe où.

 

[patricktoulon]

bonjour
perso moi je me sert du move des liste box,frame pour ooker et de leur parent respectif pour unhooker
et pas besoins de cliquer dans une liste box ou frame pour démarrer le hook

 

[patricktoulon]

tiens @Dudu2 peux tu tester cette version ultra simplifié sur un 64 c'est vrai que j'ai jamais testé si les déclaration 64 étaient bonnes

 

[Dudu2]

Bonjour @patricktoulon,

C'est sûr que c'est plus simple à gérer, beaucoup moins de code.
Le problème avec cette méthode c'est qu'Excel n'est pas toujours capable de gérer le déclenchement d'un évènement MouseMove si la souris passe trop vite.

Par exemple si, en partant de la ListBox sous Hook, la souris quitte rapidement le UserForm et/ou que la marge entre la ListBox et le UserForm est faible, l'évènement UserForm_MouseMove ne se déclenche pas et tu continues à Scroller la ListBox en ayant la souris dans la feuille.

Mais peut-être que cet inconvénient compense la simplicité de la mise en oeuvre.

 

[Dudu2]

Par contre avec cette méthode; tu ne peux pas scroller une ListBox ActiveX.
Ceci dit, qui utilise encore des ListBoxes en dehors d'un UserForm ?

 

[patricktoulon]

perso alors je rajoute dans le userform

Private Sub UserForm_Deactivate()
UnHookMouse
End Sub

des que je suis sur la feuille sur une cellule même si le userformm est affiché le hook s’arrête
bien sur là on par le userform non modal

âpres sur un userform modal je vois pas trop l’intérêt car on peut rien faire d'autres sur excel quand il est modal donc pour unhooker ca se fait dans le close ou le hide

sur une feuille utiliser le selection_change de la feuille le userform est déactivé

 

[Dudu2]

Dans la méthode que j'utilise on a besoin uniquement de faire le Hook. Le Unhook se fera automatiquement.

Dans ta méthode il faut bien prévoir le Hook et le UnHook et donc bien indiquer où le faire dans le "mode d'emploi".

Mais bon, l'une ou l'autre, une fois implémentée, ça Scroll

 

[patricktoulon]

re
et je viens de me rendre compte que la "Proc" ne s’arrête pas vraiment en fait
le scroll s’arrête oui mais pas la fonction
il aura fallu que je mette un espion avec getcursorpos et rangefrompoint pour m'en rendre compte
démonstration dans la feuille 3 avec les deux liste box
la 2d (listbox2)n'ai pas pas hooké (pour le test) seule la listbox1 l'est
en L12 et L13 j'identifie l'object sous le curseur
on se rend compte qu'une fois la listbox1 hooké même si je sort et que je unhook
en se baladant sur les cellules on se rend compte qu'elle continuent à être identifiées
même si la molette reprend le scroll de la feuille

je détruit le ctrlhooked et la structure pourtant

ca c'est une drôle de découverte
testez le fichier joint feuille 3

ca me donne idée par contre pour refaire mon mouseovercell


[Edit] autant pour moi je déclenchais une erreur et le on error resume next zappait et donc ne fermait pas le hook
il suffit donc d'ajouter ceci en début de fonction pour stopper le hook quand la souris sort du userform ou que la souris sort de la listbox dans une feuille

    Dim pos As POINTAPI, obj
    GetCursorPos pos

    On Error Resume Next    'en cas de mouvement très rapide,'évitons les crash en désactivant les erreurs
    Set obj = ActiveWindow.RangeFromPoint(pos.X, pos.Y)
    If TypeName(obj) = "OLEObject" Then
        [l12] = TypeName(obj)
        [l13] = obj.Name
        If CtrlHooked.Name <> obj.Name Then UnHookMouse: Set CtrlHooked = Nothing: GetHookStruct 0: Exit Function
     End If
    If TypeName(obj) = "Range" Then
        [l12] = TypeName(obj)
        [l13] = obj.Address
        UnHookMouse
        Set CtrlHooked = Nothing
        Exit Function
    End If

bien sur avec l'api getcursorpos declarée ansi que le type pointapi
c'est net et tout en transparence

 

[patricktoulon]

re
pour le coup j'ai régler le probleme avec range frompoint su getcursorpos pour les list sur feuille
obj= le rangefrompoint qui donne soit "range" soit "OLEObject" soit nothing
si obj <> ctrhooked alors on sort
si le ctrlhooked.name <> obj.name alors on sort

pour les userform
la c'est getwindowrect handle,rct
si le rct .left ou .right ou .top ou .bottom n'est pas dans getcursorpos alors on sort
donc ajout d'api
getcursorpos
getactivewindow
getwindowrect
et voilà terminé

 

[Dudu2]

Oui j'ai redécouvert le RangeFromPoint hier en relisant de vieilles fonctions.
Et pour le RECT du UserForm, oui, j'y avais pensé aussi, donc tu l'as fait.

 

[Dudu2]

Pour être franc, il y a un petit problème de repérage de la zone de la ListBox dans mon système.
J'ai l'impression que la zone supposée de la ListBox est un peu au dessus de sa zone réelle.
Faut que je vois ça. Pourtant je prends les marges avec l'API DWM.

 

[patricktoulon]

la zone c'est quoi le userform?

 

[Dudu2]

Non, la zone c'est la ListBox pour laquelle le Hook a été déclenché.
En ActiveX c'est très précis, en UserForm je trouve que ça Scroll avec le curseur un peu au-dessus et pas trop bien quand le curseur est vers le bas.

 

[patricktoulon]

ben met un unhook au move du parent c'est tout
moi j'ai laisser les deux
le unhook au move dans le parent de la listbox
et
le controle du left ,right, top , bottom du rect de l'userform avec getcursorpos et getwindowrect

comme ça si le move est trop rapide et que l'event passe pas ben la parti api fait son job
par contre le scroll on le déclenche au move de la listbox ou frame ou combobox
le mien fait les 3

j'ai testé avec le syndrome de la tourette impec ca fonctionne impec

en debut de procedure qui est appellée en addressof
et je dis bien dans cette procedure pas une autre
par ce celle la est declenché au moindre mouvement de souris donc reponse immediate

   Dim pos As POINTAPI, obj As Object, RcT As RECT, sortir
    If CtrlHooked Is Nothing Then Exit Function
    GetCursorPos pos
       If TypeName(CtrlHooked.Parent) = "Worksheet" Then
        Set obj = ActiveWindow.RangeFromPoint(pos.X, pos.Y)
         If TypeName(obj) = "Range" Then UnHookMouse: Exit Function
     If TypeName(obj) <> "Range" Then If obj.Name <> CtrlHooked.Name Then UnHookMouse: Exit Function
    End If

    If TypeName(CtrlHooked.Parent) <> "Worksheet" Then
        GetWindowRect GetActiveWindow, RcT
        sortir = pos.X < RcT.Left Or pos.X > RcT.Right Or pos.Y < RcT.Top Or pos.Y > RcT.Bottom
        If sortir Then UnHookMouse: Exit Function
    End If

demonstration sur feuille
listbox1 hookée et la listbox2 non hookée

demo sur userform