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]

Allez tu es prêt?
voila je reprend ton fichier 9
1 je met tout ce tointoin de gasestion d'erreur en commentaire
2 j'ajoute le callback au bon endroit!!!!!!!!!!!!
3 je bloque en comentaire ausi le callnexthook DEFINITIVEMENT(du moins pour les tests )

voici ta fonction(ca fait beaucoup de vert )

'https://learn.microsoft.com/en-us/previous-versions/windows/desktop/legacy/ms644986(v=vs.85)
Private Function LowLevelMouseProc(ByVal nCode As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    Dim Bool As Boolean
    Dim ErrNumber As Long
    'Dim Obj As Object
    Dim TopIndex As Long
    'Dim DoNotCallNextHook As Boolean
   ' Static LastTimer As Single
    
    'Test validité du ControlHooked
    'On Error Resume Next
    'Set Obj = ControlHooked
    'ErrNumber = Err.Number: Debug.Print "ControlHooked est le control: erreur " & ErrNumber
    'On Error GoTo 0
    
    'Le ControlHooked a disparu (UserForm fermé Alt + F4 par exemple)
    'If ErrNumber <> 0 Or ControlHooked Is Nothing Then
       ' Call UnHookMouse
   ' Else
        If nCode = HC_ACTION Then
            'If Int((Timer - LastTimer) * 100) >= 0 Then
                If wParam = WM_MOUSEMOVE Then
                     'Debug.Print "addresse structure hookmouse:" & lParam
                    'DoNotCallNextHook = True
                    
                    'Either on WM_MOUSEMOVE or on WM_MOUSEWHEEL
                    GoSub CheckMouseIsOverTheBox
                End If
                
                If wParam = WM_MOUSEWHEEL Then
                  LowLevelMouseProc = 1 ' la fonction est récursive!!!!!!!!!!!!!!!!!
                    'DoNotCallNextHook = True
                    
                    'Either on WM_MOUSEMOVE or on WM_MOUSEWHEEL
                    'GoSub CheckMouseIsOverTheBox

                    If Not plHooking = 0 Then
                    
                        With ControlHooked
                            'Is the Window still there ?
                            TopIndex = .TopIndex
                            
                            On Error Resume Next
                            .TopIndex = 0: Debug.Print "erreur topindex"
                            ErrNumber = Err.Number
                            On Error GoTo 0
                            
                            If ErrNumber <> 0 Then
                                Call UnHookMouse
                                Exit Function
                            End If
                            
                            .TopIndex = TopIndex
                            
                            '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
                        End With
                    End If
                'End If
            'End If
        End If
    End If

    'If Not DoNotCallNextHook Then
        'Debug.Print "rappel de secour"
        'LowLevelMouseProc = CallNextHookEx(0&, nCode, wParam, ByVal lParam)
    'End If
    
    'LastTimer = Timer
    Exit Function
    
CheckMouseIsOverTheBox:
    If Not ControlHooked Is Nothing Then
        On Error Resume Next
        Bool = MouseIsOverTheBox: Debug.Print "MouseIsOverTheBox " & Bool
        ErrNumber = Err.Number:: Debug.Print "MouseIsOverTheBox " & ErrNumber
        On Error GoTo 0

        'Run time Error 57097: le résultat de l'appel à la fonction MouseMoveFunction() n'est pas significatif, on oublie !
        If ErrNumber <> 57097 Then
            If ErrNumber = 0 Then
                'The mouse is not anymore over the ControlHooked Object
                If Not Bool Then
                    Call UnHookMouse
                End If
            End If
        End If
    End If
    Return
End Function

maintenant je vais tester avec le VBE ouvert et tout i couinti

alors tu va m'ecouter non de dieu ou pas ????

 

[Usine à gaz]

@Usine à gaz,
Tu vois, dans ces cas là, quand le PN en balance lourdement, je me retiens de devenir vulgaire.

Ne te retiens pas, il faut libérer' les gaz lol

 

[Dudu2]

Ne te retiens pas, il faut libérer' les gaz lol

Nan, faut garder le contrôle. A la limite libérer les gaz, oui, mais en privé

 

[Dudu2]

Sinon, je me suis donné la peine de ré-installer mon vieil Office 2013 32 Bits.

Ben vous savez quoi ? Ça fonctionne parfaitement sans aucune modif

.

Alors vous savez quoi ?
Les config à la mors moi le nez qui soit disant Scroll tout, pas la peine de se prendre la tête, on va bypasser et dire qu'on ne traite pas ce genre de cas

.

Et voilà. Maintenant je reviens sur mon Office 2016 64 Bits.
Mission terminée.

 

[Dudu2]

En fait, cette histoire de WM_MOUSEWHEEL qui parvient à la feuille, ça n'a sans doute pas à voir avec Office.
C'est un truc très probablement Windows puisqu'on parle ici des fonctions API utilsées pour Hooker.

 

[patricktoulon]

Les config à la mors moi le nez qui soit disant Scroll tout, pas la peine de se prendre la tête, on va

ben c'est normal quand tu retrograde tu garde tes pack redistribuable
c'est ce que je t'ai dis tout a l'heure en parlant de nettoyage
regarde chez moi aussi j'ai ceux que j'avais avec 2007

 

[patricktoulon]

re
comme tu a pu le voir dans ma capture précedente je n'ai pas grand chose d'installer mon windows est au maximum d'origine
et pour va version d'excel

 

[Usine à gaz]

re
comme tu a pu le voir dans ma capture précedente je n'ai pas grand chose d'installer mon windows est au maximum d'origine
et pour va version d'excel
Regarde la pièce jointe 1154230

Cachotier

 

[Dudu2]

Bon, mon @patricktoulon, pour appliquer ton système de Return True de la LowLevelMouseProc(), je l'ai mis en place pour le WM_MOUSEWHEEL uniquement. Car si je l'applique au WM_MOUSEMOVE la souris ne bouge plus une fois dans le Control.

Peux-tu me dire ce que ça donne chez toi ?

 

[patricktoulon]

re
et bien sur !!!!!que c'est sur le mousewell!!!!
c'est levent qui nous concerné non ???

quand je dis que tu lis pas vraiment mes messages post #346

apres tu essaie de me faire passer pour un "C..."

et bien sur que ca marche maintenant

Alléluia!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
alors on en a besoins du callnexthook ou pas

 

[Usine à gaz]

Bon, mon @patricktoulon, pour appliquer ton système de Return True de la LowLevelMouseProc(), je l'ai mis en place pour le WM_MOUSEWHEEL uniquement. Car si je l'applique au WM_MOUSEMOVE la souris ne bouge plus une fois dans le Control.

Peux-tu me dire ce que ça donne chez toi ?

Bonjour
Tout fonctionne également chez moi avec ce fichier

 

[patricktoulon]

et c'est pas peine de t'avoir mis le nez dessus plusieurs fois depuis plusieurs pages

mais non tu sais tout et tu sui MS scrupuleusement sauf que tu zappe le plus important a savoir d'une fonction en addressof

tiens je me casse tu m'a filer les boules

 

[patricktoulon]

pour info
je connais aucune api appelée en addressof qui n'a pas de callback
avec nondefonction=1 ou true
allez bye!
au final tu a compris c'est l'essentiel
je me dis que j'y suis un peu pour quelque chose

 

[patricktoulon]

et ça le fait rire le lionel avec ces fichier pétrolifères

 

[patricktoulon]