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]

et par macro tu peux enlever ajouter des modules par vba et j'en passe et des meilleures
demain tu trouve une autre merdouille tu fais quoi ? tu débloque quoi?

Si tu avais suivi tu saurais que je ne débloque plus la sécurité des macros.
Et encore du blabla et des copies d'écran pour rien. Baratin de critiques.
Il est où ton fichier ?

 

[patricktoulon]

je baratine rien
je te donne des trucs tu les teste même pas
tiens mon fichier 32 bits sur userform
alors certes sur combobox avec font size supérieur a 8 normalement il y a le bottom qui est plus ou moins juste
mais purée de purée qu'est ce que l'on s'en balance de quelque pixels a la "C.." pour un scroll

mon fichier 32 bits sur userform joint sans api WIN
je fini l'adaptation aux controls sur feuille

 

[Dudu2]

J'ai remballé mon Laptop 2016 32Bits.
Sur mon Desktop 64Bits j'ai ça dès que je passe sur un Control, et j'ai eu du mal à le chopper parce que ça se ferme très vite.

 

[patricktoulon]

alors tu a de grave problème dans ton truc ou alors tu est en vb6
à moins que j'ai mal déclaré les api hook ça je ne peut plus le faire chez moi

moi j'ai un window et un excel d'origine
et là tu peux pas dire y a plus windowfrompoint et tout y couinti

je viens de faire la fonction getControlRectangleWorksheet

démonstration
sur userform

sur feuille

donc pour les controls sur feuille
l'appel se fait
dans le move aussi mais sans le fentre parent a l'inverse du userform
hookmouseX listbox1

la fonction à ajouter

Function getControlRectangleWorksheet(obj As Object) As RECT
    Dim LfT#, Tp#, r As RECT
    With ActiveWindow
        LfT = .Panes(1).PointsToScreenPixelsX(obj.Left)
        Tp = .Panes(1).PointsToScreenPixelsY(obj.Top)
        r.Left = LfT
        r.Top = Tp
        r.Right = r.Left + (obj.Width * Ppx)
        r.Bottom = r.Top + (obj.Height * Ppx)
    End With
    
    If TypeName(obj) = "ComboBox" Then
             r.Bottom = r.Bottom + ((obj.ListRows * (obj.Font.Size)) * Ppx)
            r.Top = r.Top + (obj.Height * Ppx)
        End If
     getControlRectangleWorksheet = r
End Function

et on ajoute cette possibilité dans la sub hookmouseX

Public Sub HookMouseX(ByVal CtrL As Object, Optional ByVal FenParent As Object = Nothing)
    Dim pos As POINTAPI
    If Not FenParent Is Nothing Then Set USFForm = FenParent
    If Not CtrlHooked Is Nothing Then If CtrlHooked.Name <> CtrL.Name Then UnHookMouse
    If plHooking < 1 Then
        Set CtrlHooked = CtrL
        If Not FenParent Is Nothing Then
            rct2 = getControlRectangleForM(CtrL)
        Else
            rct2 = getControlRectangleWorksheet(CtrL)
        End If
        plHooking = SetWindowsHookExA(WH_MOUSE_LL, AddressOf LowLevelMouseProc, 0, 0)
    End If
End Sub

Terminé

 

[Dudu2]

alors tu a de grave problème dans ton truc ou alors tu est en vb6

Il faut quand même oser !
Je t'ai donné le résultat d'exécution sur mon Windows 10 Office 2016 64 Bits.

Terminé

Après 4 jours de prises de têtes sur ce sujet, je ne me sens pas de recoller les petits bouts de code que tu envoies pour en faire un truc fonctionnel.

Envoie un fichier et on voit ce que ça donne.

 

[patricktoulon]

c'est juste la fonction qui manquait pour les controls sur feuille et la prise en charge dans hookmouseX
copier coller
de toute façon on vois très bien que tu a un soucis avec les api hook dans ta capture
et toutes tes erreur que tu a bridé par du code et du code: et ben elle viennent de là

c'est comme quand tu a une référence manquante dans un fichier ça te donne des erreurs foledinguesmais jamais la vraie raison

 

[patricktoulon]

je vais attendre que d'autres testent sur 64
comme ça on sera sur

 

[Gégé-45550]

Bonsoir les cadors
Je suis sur Excel 365 64 bits.
Je viens de tester le fichier de patricktoulon.
Erreur "Incompatibilité de type" sur

LowLevelMouseProc = CallNextHookEx(0&, nCode, wParam, ByVal lParam)

et plantage instantané d'Excel.
Dudu2, vous n'êtes pas seul à avoir le pb.
Bien cordialement à tous les deux ... et au fil !

Ah, j'allais oublier ! Le fichier de Dudu2 fonctionne parfaitement chez moi.

 

[patricktoulon]

re
merci du retour @Gégé-45550

et oui je pense que l'api se gere autrement que les variable de doivent pas être du meme type sur 64

et oui met la en commentaire cette ligne( tu la bloque avec un apostrophe )

en fait j'ai fait la meme erreur que tout le monde c'est copier ces quelques lignes
sur des codes existant mais suis je bete on a pas besoins du callnexthook
puisque je met un peu plus haut dans la fonction
LowLevelMouseProc = true

en fait c'est un long il faut mettre 1

et oui elle se rappelle toute seule

donc ca donne ca la fonction

'Molette souris  Up/Down Listbox , ComboBox , Frame
Private Function LowLevelMouseProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim pos As POINTAPI, obj As Object, r As Range, CtL
    On Error Resume Next
    GetCursorPos pos
    If pos.Y < rct2.Top Or pos.Y > rct2.Bottom Or pos.X < rct2.Left Or pos.X > rct2.Right Then UnHookMouse: Exit Function
    If (nCode = HC_ACTION) Then
        If wParam = WM_MOUSEWHEEL Then
            LowLevelMouseProc = 1
            With CtrlHooked
                Select Case TypeName(CtrlHooked)    ' déplace l'ascenseur en fonction de la molette ' l'info est stockée dans lParam
                Case "ListBox", "ComboBox": If GetHookStruct(lParam).mouseData > 0 Then .TopIndex = .TopIndex - 1 Else .TopIndex = .TopIndex + 1
                Case "Frame": If GetHookStruct(lParam).mouseData > 0 Then .ScrollTop = .ScrollTop - 4 Else .ScrollTop = .ScrollTop + 4
                End Select
            End With
        End If
        Exit Function
    End If
     On Error GoTo 0
End Function

allez encore une api qui saute

 

[patricktoulon]

maintenant je sais pourquoi @Dudu2 avait tout ces crashs
je suis vraiment bête des fois c’était en face de nos yeux
et je supose que @Dudu2 ne fait pas un rappel en call back LowLevelMouseProc = 1
si je bloque cette ligne et bien j'ai le même problème qu'avec son fichier
a savoir le scroll du control et la feuille excel

j’hallucine c’était en face de mes yeux depuis tout ce temps

edit :
je confirme il ne le fait pas je l'ai fait et voila tranquille ca roule ma poule

 

[Gégé-45550]

Bonsoir patricktoulon,
désolé, c'est encore pire ... maintenant Excel plante sans même le moindre message.
Bonne nuit.

 

[patricktoulon]

ok recu
le soucis se situe là alors c'est peut etre ca le truc en 64 il faut faire un nexthook et en 32 le callback fonctionne

 

[Dudu2]

Bonjour à tous,

Il est quand même utile de lire la doc de LowLevelMouseProc callback function:

LowLevelMouseProc callback function (Windows)

learn.microsoft.com

Qui doit retourner un LRESULT (LongPtr). Et surtout un Return qui doit venir de la fonction CallNextHookEx pour tarir la source des messages.

it is highly recommended that you call CallNextHookEx and return the value it returns; otherwise, other applications that have installed WH_MOUSE_LL hooks will not receive hook notifications and may behave incorrectly as a result.

 

[patricktoulon]

re
ben oui il est utile de lire oui

j'ai traduit la page

donc utile oui ;notamment le paragraphe que j'ai mis en rouge et celui que j'ai mis en vert
qui nous apportent une réponse quasiment claire comme de l'eau de roche

a moins que j'ai compris de travers
lancé par SetWindowsHookEx le callback est automatique
je cite

Cependant, le crochet WH_MOUSE_LL n'est pas injecté dans un autre processus. Au lieu de cela, le contexte revient au processus qui a installé le hook et il est appelé dans son contexte d'origine. Ensuite, le contexte revient à l'application qui a généré l'événement.

on lit plus bas que le delay est plus important sur window10et + ce qui implique un recall

ma conclusion est que l'on arrivera pas a créer une seule méthode gérant le 32 vb6 / 32 vba7 / 64 vba7.01

Remarques​

Une application installe la procédure de hook en spécifiant le type de hook WH_MOUSE_LL et un pointeur vers la procédure de hook dans un appel à la fonction SetWindowsHookEx .


Ce hook est appelé dans le contexte du thread qui l'a installé. L'appel est effectué en envoyant un message au thread qui a installé le hook. Par conséquent, le thread qui a installé le hook doit avoir une boucle de message.


L'entrée de la souris peut provenir du pilote de souris local ou d'appels à la fonction mouse_event . Si l'entrée provient d'un appel à mouse_event , l'entrée a été "injectée". Cependant, le crochet WH_MOUSE_LL n'est pas injecté dans un autre processus. Au lieu de cela, le contexte revient au processus qui a installé le hook et il est appelé dans son contexte d'origine. Ensuite, le contexte revient à l'application qui a généré l'événement.


La procédure de hook doit traiter un message en moins de temps que l'entrée de données spécifiée dans la valeur LowLevelHooksTimeout dans la clé de registre suivante :


HKEY_CURRENT_USER \ Panneau de configuration \ Bureau


La valeur est en millisecondes. Si la procédure de hook expire, le système transmet le message au hook suivant. Cependant, sous Windows 7 et versions ultérieures, le hook est supprimé en mode silencieux sans être appelé. L'application n'a aucun moyen de savoir si le crochet est supprimé.


Windows 10 version 1709 et versions ultérieures La valeur de délai d'expiration maximale autorisée par le système est de 1 000 millisecondes (1 seconde). Le système utilisera par défaut un délai d'attente de 1 000 millisecondes si la valeur LowLevelHooksTimeout est définie sur une valeur supérieure à 1 000.


Remarque Les crochets de débogage ne peuvent pas suivre ce type de crochets de souris de bas niveau. Si l'application doit utiliser des crochets de bas niveau, elle doit exécuter les crochets sur un thread dédié qui transmet le travail à un thread de travail, puis revient immédiatement. Dans la plupart des cas où l'application doit utiliser des crochets de bas niveau, elle doit plutôt surveiller l'entrée brute. En effet, l'entrée brute peut surveiller de manière asynchrone les messages de la souris et du clavier qui sont ciblés pour d'autres threads plus efficacement que les crochets de bas niveau. Pour plus d'informations sur l'entrée brute, consultez Entrée brute .

 

[Dudu2]

J'ai amélioré la réactivité du Scroll pour la rendre totale en réduisant le contrôle d'intervalle d'appels de la LowLevelMouseProc callback function. Maintenant seuls les appels sur un Timer identique sont ignorés.

De plus, j'ai placé en priorité la condition de fermeture de la fenêtre VBE pour le 64Bits que je n'arrive toujours pas à faire avec l'API lorsque l'Accès approuvé au modèle d'objet du projet VBA n'est pas coché. Je suis obligé de le faire en activant la fenêtre VBE et en faisant Alt + F4.
Je vais placer un fichier à l'intention de toute personne souhaitant résoudre ce problème.

Là je pense qu'on approche la formule qui va bien.