Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2019 Molette Scroll sur ListBox

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion gg13
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
G

gg13

XLDnaute Occasionnel
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
 

Pièces jointes

Trier par date Trier par votes

et oui c'est la ou je vois que tu n'a pas compris comment ca fonctionne

une fois qu'elle est enclenchée il n'y a que le bool qui l'arrête

et si tu n'avais pas lu en diagonal mes commentaires tu aurais vu que je fait d'office le test overbox
regarde mieux fait moi plaisir

et j'insiste aussi sur le fait de OU JE MET LE CALLBACK
j'attends pas de gérer plus ou moins bien une erreur quelconque qui pourrait arriver et unhooker avant la gestion ce qui fait que le callback serait jamais rappelé

Gestion de l'erreur sur .TopIndex:
Il faut la capter et UnHooker.
Cliquez pour agrandir...
et pourquoi voudrais tu que ça ne le soit pas
si il y a une erreur la gestion global va être enclenché
le on error goto gestion_d_erreur est valable de la première à la dernière ligne de code
comme le callback est annoncé elle peut tourner tourner elle atterrira toujours là
elle ne sortira que par Bool
en toute transparence

regarde



regarde des que je suis entré dans le controls et que je bouge que je scroll ou danse sur la tête
quelque soit le message de la souris l'effetest là et cela sans le WM_MOUSEMOVE
regarde bien la cellule C1 je met un nombre au hasard a chaque message
tu vois tu n'en a pas besoins
c'est absolument inutile tout tes gestions d'erreur


FINALEMENT
on a besoin de quoi????????
d'intercepter le message de la molette de la souris c'est tout
1 on gere les erreur globalement
2 on relance le callback au mouse well pour qu'elle reparte au prochain message
3 la dessus on fait un control rectangle (checkoverbox )
bool=oui ou non
si oui ben scroll sinon unhook ou l'inverse comme tu veux
gestion d'erreur (NIMPORTE QUELLE ERREUR) on relance un nexthook
et c'est terminé

c'est d'une simplicité
 
Dernière édition:
Vote positif 0 Vote négatif
regarde pour te dire a quel point tu t ennuie pour rien
je vais prendre ma version de la fonction de mon fichier
et je vais y mettre ton test bool(checkovertrucmachin chouete) et ca va marcher pareil

VB: 
'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
    Dim Bool
    On Error Resume Next
    GetCursorPos pos
    'je bloque mon test rectangle
    'If pos.Y < rct2.Top Or pos.Y > rct2.Bottom Or pos.X < rct2.Left Or pos.X > rct2.Right Then UnHookMouse: Exit Function

    'je met le tiens
CheckMouseIsOverTheBox:
    Bool = MouseIsOverTheBox
    If Not Bool Then
        Call UnHookMouse: Exit Function
    End If


    If (nCode = HC_ACTION) Then
        If wParam = WM_MOUSEWHEEL Then
            LowLevelMouseProc = True
            'et c'est ici que vous avez un probleme sur 64 vec le delay
            With ControlHooked
                Select Case TypeName(ControlHooked)    ' 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 - 3 Else .ScrollTop = .ScrollTop + 3
                End Select
            End With
        End If
        Exit Function
    End If
    'partie gestion d'erreur
    DoEvents: Debug.Print Err.Number
    On Error GoTo 0
    
    'LowLevelMouseProc = CallNextHookEx(0&, nCode, wParam, ByVal lParam)
End Function

démonstration
 
Vote positif 0 Vote négatif
on a besoin de quoi???????? d'intercepter le message de la molette de la souris c'est tout
Cliquez pour agrandir...
Non, ça sert à rien de récupérer la position de la souris sur un MOUSEWHEEL.
La souris ne change de position QUE sur un MOUSEMOVE.
C'est pour cette raison que j'utilise le MOUSEMOVE.
on gere les erreur globalement
Cliquez pour agrandir...
Ce n'est pas suffisant. Sur une erreur de .TopIndex il faut UnHooker. C'est pas suffisant de faire Resume Next.

Ce code est d'une simplicité enfantine. Mais faire simple, c'est plus compliqué que de faire compliqué.
VB: 
Private Function LowLevelMouseProc(ByVal nCode As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Dim Obj As Object
    Dim DoNotCallNextHook As Boolean

    'Prevent Excel crash (e.g. Alt+F4 on UserForm with Hooked Control)
    On Error Resume Next
  
    'Test validité du ControlHooked
    Set Obj = ControlHooked
  
    'Le ControlHooked a disparu ?
    If Err.Number <> 0 Or Obj Is Nothing Then
        Err.Clear
        Call UnHookMouse
    Else
        If nCode = HC_ACTION Then
            If wParam = WM_MOUSEMOVE Then
                'Check if the mouse is still on the Control
                If Not MouseIsOverTheBox Then
                    Call UnHookMouse
                End If
            End If
          
            If wParam = WM_MOUSEWHEEL Then
                DoNotCallNextHook = True
              
                With ControlHooked
                    'Is the Window still there (.TopIndex in error) ?
                    Err.Clear
                  
                    'Moves the ScrollBar depending on the mouse wheel, Info is stored in lParam
                    If GetHookStruct(lParam).mouseData > 0 Then
                        If .TopIndex < ScrollStep Then .TopIndex = 0 Else .TopIndex = .TopIndex - ScrollStep
                    Else
                        .TopIndex = .TopIndex + ScrollStep
                    End If
                  
                    'Is the Window still there (.TopIndex in error) ?
                    If Err.Number <> 0 Then
                        Err.Clear
                        Call UnHookMouse
                        Exit Function
                    End If
                End With
            End If
        End If
    End If

    If Not DoNotCallNextHook Then
        LowLevelMouseProc = CallNextHookEx(0&, nCode, wParam, ByVal lParam)
    Else
        LowLevelMouseProc = True
    End If

    On Error GoTo 0
End Function
 
Vote positif 0 Vote négatif
1° je ne fait pas un on erreur resume next avec ta fonction

2°je fait un on error goto gestion_d_erreur
c'est loin d'être la même chose 😉

3°et je ne récupère pas le box over au mouse well je le récupère tout court


4° le topindex va déclencher une erreur si =0 et molette vers le haut
ben que cela te tienne là encore c'est l’étiquette gestion_d_erreur qui va être sollicitée


tu lis en diagonale 😉

je te l'ai dis prends le temps de me lire
 
Vote positif 0 Vote négatif
J'ai bien vu les différences. Mais qu'est-ce que tu veux au juste ? Que je mette ton code à la place du mien ?
NON ! J'ai fais mon code, il me plait et je n'aime pas le GOTO.

Et pourquoi tu ne mettrais mon code à la place du tien ? Après tout je pourrais aussi te harceler pour faire ça ? Et d'ailleurs je vais le faire... Pourquoi tu n'utilises pas mon code à la fin ?

Si tu veux utiliser ton code dans tes programmes personne ne t'en empêche et surtout pas moi.
Qu'est-ce que c'est que cette insistance ?
 
Vote positif 0 Vote négatif
je n'insiste pas sur ton code ou le mien
je te dis seulement que tu en fait beaucoup pour rien
a quoi sert de faire 36 gestions d'erreur qui t'amèneront au même endroit
c'est a dire peut être un unhook et reprise si toujours dans le controls
tu n'aime pas les goto OK mais les gosub( il me semble en avoir vu un) c'est pareil

a près tu a raison tu fait comme tu veux
 
Vote positif 0 Vote négatif
tiens après j'arrête parce que tu comprends pas
ça c'est ton code
j'ai bloqué des lignes et je commente
dis moi que j'ai tords 😉
VB: 
Private Function LowLevelMouseProc(ByVal nCode As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Dim Obj As Object
    Dim DoNotCallNextHook As Boolean

    'Prevent Excel crash (e.g. Alt+F4 on UserForm with Hooked Control)
    On Error Resume Next
 
    'Test validité du ControlHooked
    Set Obj = ControlHooked
 
    'Le ControlHooked a disparu ?
    If Err.Number <> 0 Or Obj Is Nothing Then
        Err.Clear
        Call UnHookMouse
    Else
        If nCode = HC_ACTION Then
            '!!!! et pourquoi attendre de bouger la souris pour savoir si on est dedans  le control
            '!!!je peux tres bien rester immobile et ne toucher que la mollette
            '!!!!au quel cas cette condition passera inapercue
            'If wParam = WM_MOUSEMOVE Then
                'Check if the mouse is still on the Control
                If Not MouseIsOverTheBox Then
                    Call UnHookMouse
                End If
            'End If
         
            If wParam = WM_MOUSEWHEEL Then
                DoNotCallNextHook = True
             
                With ControlHooked
                    'Is the Window still there (.TopIndex in error) ?
                    Err.Clear
                 
                    'Moves the ScrollBar depending on the mouse wheel, Info is stored in lParam
                    If GetHookStruct(lParam).mouseData > 0 Then
                        If .TopIndex < ScrollStep Then .TopIndex = 0 Else .TopIndex = .TopIndex - ScrollStep
                    Else
                        '!!!!!on fait pareil que a fait pour le "-" mais l'inverse
                        If .TopIndex < .ListCount - ScrollStep Then .TopIndex = .TopIndex + ScrollStep
                    End If
                 
                    '!!!!!!!on peut donc supprimer toute cette gestion d'erreur
                    'Is the Window still there (.TopIndex in error) ?
                    'If Err.Number <> 0 Then
                       ' Err.Clear
                        'Call UnHookMouse
                        'Exit Function
                    'End If
                End With
            End If
        End If
    End If

    If Not DoNotCallNextHook Then
        LowLevelMouseProc = CallNextHookEx(0&, nCode, wParam, ByVal lParam)
    Else
        LowLevelMouseProc = True
    End If

    On Error GoTo 0
End Function
 
Dernière édition:
Vote positif 0 Vote négatif
tiens après j'arrête parce que tu comprends pas
ça c'est ton code
j'ai bloqué des lignes et je commente
dis moi que j'ai tords 😉

VB: 
'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
    Dim Bool
    
    '!!!! Gestion d'erreur généraliste
    '!!!! Couvre les erreurs générales et ignore les traitements particuliers nécessaires
    '!!!! Si le .TopIndex se plante il n'y a pas de UnHook, c'est juste Resume Next !!!!
    '!!!! Si le Control Hooked a disparu pour une raison ou une autre il n'y a pas de UnHook, c'est juste Resume Next !!!!
    '
    On Error Resume Next
    GetCursorPos pos
    'je bloque mon test rectangle
    'If pos.Y < rct2.Top Or pos.Y > rct2.Bottom Or pos.X < rct2.Left Or pos.X > rct2.Right Then UnHookMouse: Exit Function

    'je met le tiens
CheckMouseIsOverTheBox:

    '!!!! Pourquoi lancer la fonction lorsque c'est un WM_MOUSEWHEEL
    '!!!! Ça sert strictement à rien
    '
    Bool = MouseIsOverTheBox
    If Not Bool Then
        Call UnHookMouse: Exit Function
    End If


    If (nCode = HC_ACTION) Then
        If wParam = WM_MOUSEWHEEL Then
            LowLevelMouseProc = True
            'et c'est ici que vous avez un probleme sur 64 vec le delay
            With ControlHooked
                Select Case TypeName(ControlHooked)    ' 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 - 3 Else .ScrollTop = .ScrollTop + 3
                End Select
            End With
        End If
        Exit Function
    End If
    'partie gestion d'erreur
    DoEvents: Debug.Print Err.Number
    On Error GoTo 0
    
    'LowLevelMouseProc = CallNextHookEx(0&, nCode, wParam, ByVal lParam)
End Function
 
Vote positif 0 Vote négatif
re
VB: 
Private Function LowLevelMouseProc(ByVal nCode As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Dim DoNotCallNextHook As Boolean

    'Prevent Excel crash (e.g. Alt+F4 on UserForm with Hooked Control)
    On Error Resume Next ' Globale error gestion
    If ControlHooked Is Nothing Or Err.Number > 0 Then
        UnHookMouse
        Err.Clear: Exit Function
    Else
        If nCode = HC_ACTION Then
            If Not MouseIsOverTheBox Then Call UnHookMouse: Exit Function

            If wParam = WM_MOUSEWHEEL Then
                DoNotCallNextHook = True

                With ControlHooked
                      'Err.Clear  'absolutely useless

                    'Moves the ScrollBar depending on the mouse wheel, Info is stored in lParam
                    If GetHookStruct(lParam).mouseData > 0 Then
                        If .TopIndex < ScrollStep Then .TopIndex = 0 Else .TopIndex = .TopIndex - ScrollStep
                    Else
                        '!!!!!on fait pareil que a fait pour le "-" mais l'inverse
                        If .TopIndex < .ListCount - ScrollStep Then .TopIndex = .TopIndex + ScrollStep
                    End If

                End With
            End If
        End If
    End If

    If Not DoNotCallNextHook Then
        'triggers a new  hook if an error is incurred
        LowLevelMouseProc = CallNextHookEx(0&, nCode, wParam, ByVal lParam)
    Else
        LowLevelMouseProc = True 'callback of function
    End If

    On Error GoTo 0 'close and empty  the stack of error
End Function
 
Vote positif 0 Vote négatif
Voilà, de retour au PC.
Je fractionne, avec ou sans figer les volets, je Scroll le Pane 4 (où se trouvent les ActiveX) en vertical + horizontal.
Chez moi aucun problème sur les Controls ActiveX (je suppose que tu fais référence à ceux-ci).
Je suis étonné que tu aies ce problème car c'est le truc habituel Pan.PointsToScreenPixelsX/Y qui fonctionne sur toutes les versions d'Excel.

Le fichier à utiliser est celui de la ressource que j'ai créée:

VBA - Scroll en Controls ActiveX & UserForm (ListBox, ComboBox, TextBox, UserForm, Frame, MultiPage)

Le fichier à télécharger contient: Le Module_ControlScroll à importer dans le projet VBA. Une feuille de test contenant des Controls ActiveX. Un UserForm de test contenant des Controls imbriqués. Les principales caractéristiques: Permet le...
excel-downloads.com
 
Vote positif 0 Vote négatif
Il est vrai cependant qu'il y a un temps de latence de l'ordre d'une seconde sur le tout 1er Mouse Over de la ListBox1. Il faudrait que je trace mais je pense que l'évènement MouseMouve() se déclenche avec du retard. Ou c'est autre chose. Seules les traces donneront la raison.
Je joins un fichier de test.
 

Pièces jointes

Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

K
  • Question Question
XL 2016 Défiler le contenu d'une ListBox sur un formulaire
Réponses
2
Affichages
2 K
kwameviagbo
K
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…