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]

et tiens pour les cas ou soit disant ça devrait dérailler
pour le fun j'empile des combobox je fait la collection

puré c'est costaut comme approximation je vous le dis moi

et pour info voila ce que j'ai dans le module du userfom

'**********************************************************************************
' __        _____  ___   .  ___         _____  ___             ___
'|__|  /\     |   |   |  | |     | /      |   |   | |   | |   |   | |\  |
'|    /__\    |   |---   | |     |/\      |   |   | |   | |   |   | | \ |
'|   /    \   |   |   \  | |___  |  \     |   |___| |___| |__ |___| |  \|

'***********************************************************************************
'userform exemple d'utilisation du module de hooking de la souris  pour le Scroll avec la mollette(simplifié)
'version 4.0
'Date version :octobre 2022
'Auteur: patricktoulon sur exceldownloads
Option Explicit
Private Sub UserForm_Initialize()
    Dim I&, a&
    For I = 1 To 100
        ComboBox1.AddItem I
        For a = 3 To 6
            Me.Frame2.Controls("ComboBox" & a).AddItem I * 100
        Next
        qliste.AddItem I * 45
    Next
End Sub

Private Sub ComboBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    HookMouse ComboBox1
End Sub

Private Sub ComboBox2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    HookMouse ComboBox2
End Sub
Private Sub ComboBox3_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    HookMouse ComboBox3
End Sub
Private Sub ComboBox4_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    HookMouse ComboBox4
End Sub
Private Sub ComboBox5_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    HookMouse ComboBox5
End Sub
Private Sub ComboBox6_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    HookMouse ComboBox6
End Sub


Private Sub qliste_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    HookMouse qliste
End Sub

Private Sub Frame1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    HookMouse Frame1
End Sub


'a cas ou il y aurait eu un bug quelque part et que le houk ne se serait pas arrêté
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    UnHookMouse
End Sub

 

[Dudu2]

C'est super super compliqué ce système de fenêtres pour les ComboBoxes dans les UserForms.
On croit cliquer dans la fenêtre de la Combo, en fait c'est la fenêtre du Frame si présent ou du Inside UserForm qui vient.
J'ai tout testé de l'API GetWindowLong pour essayer de discriminer.
Je m'attendais à un truc simple: tester si la fenêtre a une ScrollBar verticale. Ben non, ça marche pas !

Et puis j'ai fait des tests des RECT et j'ai trouvé une particularité qui me permettra peut-être de discriminer entre la fenêtre Combo (qui n'est pas celle qui revient) et la fenêtre DropDown en MouseOver.
On verra ça demain car il est bien tard.
Bonne nuit les petits

.

 

[Dudu2]

Ah, pour compléter...

Il y a aussi une autre méthode qui serait très simple à implémenter pour les ComboBoxes avec l'évènement _DropDownButton.
En effet, comme je l'ai dit auparavant, il ne peut y avoir qu'une seule ComboBox (ActiveX et UserForm) déployée car pour déployer une ComboBox il faut cliquer, et tout Clic rembobine toute autre ComboBox déployée. Et chaque fois on passe dans l'évènement _DropDownButton quand ça déploit et quand ça replie, et on sait ce qu'il en est ! C'est ça qui vaut de l'or

.

De sorte qu'on peut très facilement gérer le ON/OFF de déploiement dont on connait la ComboBox.
Et si on est en MouseOver sur cette CombBox, c'est forcément du Scroll à faire.

Mais, pour ne pas avoir à gérer 2 évènements, je vais essayer la solution à un à seul évènement MouseOver / MouseMove dont j'ai parlé ci-dessus.

 

[patricktoulon]

essaie essaie
tu te demande pourquoi le data recu par tes différentes méthodes est erroné
alors tu le vois pas bien dans ma démo animé mais le combobox a une structure quand il n'a pas le focus
et une autre structure quand il a le focus

et je parle même pas du frame ça maintenant tu dois le savoir le smilblick avec les frames

en fait c'est du a leur programmation interne qui a été adapté pour vba
ce qui a pour effet de ne pas pouvoir faire certaine choses

exemple
prends un usefrorm
met lui une frame
met un bouton dans la frame
et dans l'event du bouton

Private Sub CommandButton1_Click()
MsgBox ActiveControl.Name
End Sub

et ben regarde c'est quoi l'activecontrol retourné
et après tu eassaie

Private Sub CommandButton1_Click()
MsgBox Frame1.ActiveControl.Name
End Sub

 

[Dudu2]

Bonjour à tous,
J'espère que vous allez bien !
Voici mon dernier fichier. Si ça marche chez @Usine à gaz, ou quiconque est en 365 et chez les autres , c'est gagné. Seuls les tests sont déterminants. Le baratin, c'est du vent.

 

[patricktoulon]

Bonjour dudu2
ha là ça commence a devenir intéressant
quelque commentaires dans le code auraient été le bien venu
juste un tout petit soucis pour les combo dans feuille
il y a un trou lors de la molette entre le top de la combo et le top de la child
un coup de molette intempestif et hop voilà qu'on lui coupe la tête
sinon ça match

en regardant le code en fait tu a pris le probleme a l'envers tu capte la child et cherche le parent (getparent)

ce que je pige pas par contre c'est ca

 'If these 2 Windows have the same RECT
    If BoxRECT.Left = ParentBoxRECT.Left And BoxRECT.Top = ParentBoxRECT.Top _
    And BoxRECT.Right = ParentBoxRECT.Right And BoxRECT.Bottom = ParentBoxRECT.Bottom Then
        'This is the UserForm ComboBox DropDown Window RECT

je dis ça parce que je sais que la child si on change pas la propriété listwidth de la combo fait 3/4 pixels de plus
voir capture

donc normalement ta condition devrait renvoyer un résultat negatif

 

[Staple1600]

Bonjour @Dudu2

Mauvaise nouvelle.
Ca a planté mon Excel 365!

Et j'ai perdu ce j'étais en train de faire
Snif
(mais j'avais qu'a faire un CTRL+S)

 

[Staple1600]

@Dudu2
Précisions
Le crash s'est produit quand je testais sur la feuille
Pas eu le temps de tester les userforms
Excel s'est fermé sans prévenir.

Je récupère ce que j'ai perdu et je retesterai avec ton seul classeur ouvert.

 

[Usine à gaz]

Bonjour Dudu2, Bonjour Patrick, Bonjour JM, les autres lol, le Forum
Ce qui fonctionne :

Ne fonctionne pas :

Dudu2, tu es y es presque tout bien
Pas de plantage chez moi pendant mes tests.
Bravo à vous 2 et à tous les participants, quel formidable travail.

 

[Dudu2]

@patricktoulon,

Il y a un trou lors de la molette entre le top de la combo et le top de la child

Évidemment, et c'est parfaitement normal !
Essaie une ComboBox ActiveX normale (sans Scroll), déploie-la et Scroll la page, tu verras que le "trou" se fait.
Le Scroll que j'introduis respecte complètement le comportement normal sans Scroll.

'If these 2 Windows have the same RECT
If BoxRECT.Left = ParentBoxRECT.Left And BoxRECT.Top = ParentBoxRECT.Top _
And BoxRECT.Right = ParentBoxRECT.Right And BoxRECT.Bottom = ParentBoxRECT.Bottom Then

Et oui, ça c'est ma découverte exclusive

de tard hier soir qui me permet de discriminer

.

@Staple1600,
Désolé pour avoir provoqué la perte de ton travail en cours. Je sais à quel point c'est frustrant.
Les crash sur Scroll dégagent violemment tout ce qui traine. J'aurais dû prévenir.

@Usine à gaz,
J'ai modifié la partir ComboBox ActiveX pour la rendre quasi-similaire à la partie ComboBox UserForm.
Ça fonctionne chez moi et chez @patricktoulon, mais en 365 ça bug.
J'aimerais bien debugger sur 365 car la méthode employée est simple et il y a peut-être pas grand chose à faire pour que ça fonctionne. Mais je n'ai pas de 365 à disposition.
Donc je vais revenir sur la méthode précédente qui me plait moins mais qui devrait fonctionner.
A voir au prochain fichier

.

 

[Staple1600]

Re

@Dudu2
J'ai retué mon Excel cette fois pas à l'insu de mon plein gré
En testant sur les Userform

Excel 365 n'aime pas le Hooking
(et si j'osais, je dirais qu' il a bien raison )

 

[Staple1600]

Re

@Dudu2
[Précisions]
Excel se ferme quoique je fasse
Donc je ne peux même pas aller voir dans VBE où cela coince.

PS: J'ai testé en n'ayant que ton classeur ouvert dans Excel.

 

[Dudu2]

Voilà pour la correction de la ComboBox ActiveX qui ne fonctionnait pas chez @Usine à gaz.

@Staple1600, il doit y avoir un problème de fond dans la code du Hook. Mais ça...
Peux-tu donner les détails de ta config ? Windows 10/11 ? 32/64 ? 365 (je suppose 64 bits ?)
Pour comparer avec celle d'@Usine à gaz.

 

[Staple1600]

@Dudu2
W10 (22H2) 64 bits
Microsoft® Excel® pour Microsoft 365 MSO (Version 2209 Build 16.0.15629.20200) 64 bits

Comparer quoi avec Usine à Gaz?

Tu veux dire tester la PJ du message#133?

 

[patricktoulon]

Attention un collègue de boulot vient de me dire
que 365 plante(whitescreen) ou fermeture brutale si les déclarations d'api ne sont pas conformes
longptr pas partout
contrairement a chez moi par exemple sur 2013 32 et VBA7 ou il s'en fou un peu je dirais
c'est peut être une piste
pour info ça plante chez mon collègue aussi