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

 

[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

 

[Dudu2]

ben met un unhook au move du parent c'est tout

Oui je comprends ce que tu veux faire.

Mais ça m'ennuie de devoir mettre des UnHook. Le UnHook doit se faire tout seul à la sortie de la zone directement dans la fonction de Hook qui appelle la fonction de positionnement pour à chaque fois savoir si elle doit continuer ou stopper le Hooking.
D'ailleurs le UnHook se fait. Mais c'est ma zone qui semble décalée. Faut que je vérifie. Mais là j'ai pas trop le temps.

 

[patricktoulon]

Bonjour @Dudu2
je fouille dans mes vieux truc et ...je retrouve des truc que j'avais complètement zappé
et si je te proposais de savoir zoner le rectangle de la listbox en pixel ?
1°connaître directement le handle de la listbox
2°déterminer le rectangle avec la même api "getwindowrect"
3° tu pourrais contrôler simplement la position avec getcursorpos

 

[Dudu2]

Salut @patricktoulon,
Alors ça oui, ce serait super !
Plus besoin de faire des calculs complexes.

 

[patricktoulon]

je te fait un exemple comme ca vite fait donne moi 5 minutes

 

[Dudu2]

Pas de souci, prends ton temps. Je bosse sur un truc en parallèle.

 

[patricktoulon]

dans cet exemple j'ai deux listbox dans le userform
au move de celles ci de détermine leur handle et leur le rect
dans cet exemple je me sert aussi du move du userform (c'est juste pour l'exemple)
mais le changement se fait grace au rect et getcursorpos

comme dans la fonction en adressof pour la molette cette fonction tourne tant que on l’arrête pas ben tu met ca dans celle ci
et voilà tu n'a plus besoins du parent move
les seuls move sont celle des listbox qui le démarre
et le unhook seulement s’appellera dans la fonction de hook (c'est rigolo non)
userform de démonstration pour déterminer les rect des listbox

je t'ai fait ca vite fait mais le principe est là

 

[patricktoulon]

ca y est je l'ai adapté a mon model mollete (listebox frame combobox) et ca match pour les listbox et frame
sauf pour la combobox bien évidemment car le rectangle qui est donné donne le rectangle(combo non développé) çà c'est dommage
il faut soit exepter les combo soit rectifier le rectangle( le bottom )par listrow*font.size*1.25

 

[Dudu2]

@patricktoulon, question sans rapport.
Est-ce que tu sais déterminer si un UserForm est appelé par un autre UserForm ?
Rapport à ça -> https://excel-downloads.com/threads/vba-tcd-questions-diverses.20071393/post-20542927

 

[Dudu2]

Nan, laisse tomber la question, j'ai peut-être une solution car je passe par un Public Function du UserForm pour l'afficher et donc dans cette fonction je connais le Handle qui l'appelle.
De toutes façons, les Parents des UserForms qui s'empilent c'est toujours l'application Excel, jamais le UserForm de niveau précédent.

 

[patricktoulon]

re
oui moi aussi j'utilise une variable public

De toutes façons, les Parents des UserForms qui s'empilent c'est toujours l'application Excel, jamais le UserForm de niveau précédent.

sauf si tu fait un setparent pour affilier le usf2 a l'usf 1(appelant)

 

[Dudu2]

ok je vais faire ça.
Au moment de l'appel de la fonction publique, je capte le Handle de l'appelant et dans l'activate du Usf2 je le définis comme parent.
Si l'appelant est la Window, ça restera la Window.
Si c'est le Usf1, il deviendra le parent au lieu de la Window.

Mais j'ai des comportements très étranges car différents. Car jusque maintenant ça marchait sans que je fasse rien et maintenant non. Ça vient d'arriver là, sur un nouveau UserForm ! Et les anciens fonctionnent.

 

[Dudu2]

Le Usf2 il accepte pas de passer de passer sous le Usf1.
Là je suis bien dans la m... Toute mon appli est basée sur ces outils. Une grosse appli.
Et là bizarrement un truc se dérègle dans les retour de UserForm et je suis bloqué.

Demain je vais essayer de réduire le problème dans un fichier pour tester et que tu voies si tu as des idées.

 

[Dudu2]

J'ai aussi essayé un SetForeGroundWindow à la sortie du Usf2 pour revenir sur Usf1 mais ça provoque des interruptions. La m...

 

[Dudu2]

J'ai un petit espoir avant d'aller dormir !
il SEMBLE qu'un truc comme ça à la fin de la Fonction Publique fonctionne et ne fasse plus d'interruption (il faut dire que j'utilise souvent ESC pour sortir des UserForm et là j'ai dû collisionner).

    'Activate le Caller
    Application.EnableCancelKey = False
    SetForegroundWindow MsgBoxPerso_CallingHandle
    Application.EnableCancelKey = True

Je touche du bois et je verifierai demain.