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]

Fichier simplifié pour la détection Curseur sur ListBox uniquement et pas un code généraliste sur des Objects quelconques.

@Usine à gaz, merci de ton retour. Prends plutôt ce fichier simplifié (un peu plus court) sur la partie indiquée. Je supprime le fichier précédent.

Edit: Fichier supprimé, voir plus bas.

 

[Dudu2]

Bonjour la liste,

Le code que je propose ici est basé sur le fait que le Hooking, une fois lancé sur la ListBox, sait déterminer (avec la fonction MouseIsOverListBox) si le curseur est toujours sur l'objet Hooké ou pas pour continuer ou arrêter le Hooking.

Ça implique de comparer la position du curseur par rapport à la position et la surface de la ListBox.
C'est cette partie qui est un peu délicate et je l'ai mise à jour avec mes connaissances les plus récentes concernant les Marges des UserForms sur différentes configurations Windows & Office.
La fonction MouseIsOverListBox a un peu grossi.

Je suis donc passé à la vitesse supérieure pour:
- Faire fonctionner le Scroll dans une ListBox Control ActiveX (voir fichier),
- Gérer les positions / surfaces des ListBoxes Control de UserForm placées dans des Frames ou des MultiPages,
- Gérer positions / surfaces des ListBoxes Control de UserForm en prenant en compte les bordures des UserForms de différentes configurations Windows & Office.

 

[gg13]

Bonjour ,
Dudu2, merci pour ces modifications qui fonctionnent très bien pour moi.
Utiliser le scroll sans clic sur la listBox est pratique.
Pas assez de connaissances VBA pour moi pour comprendre le tout.
Je laisse les "doués" du forum t'aider à améliorer le code.
Merci à tous et bonne semaine.
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

 

[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.