Scroller dans une fram avec la mollette de la souris

Le 07/08/2019 à 14:07

Salut tous le monde,

J'aimerais faire en sorte que lorsque je j'utilise la molette de ma souris dans une fram avec une scroll bar. Cela fasse baisser mon emplacement dans la fram. Comme sur n'importe quelle application comme un document word un navigateur ou un bloc note.

J'ai bien trouver un module sur internet le voici :

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public Enum OWNER
    eSHEET = 1
    eUSERFORM = 2
End Enum
Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private Type MSLLHOOKSTRUCT
    pt As POINTAPI
    mouseData As Long
    flags As Long
    time As Long
    dwExtraInfo As Long
End Type
Private Const HC_ACTION = 0
Private Const WH_MOUSE_LL = 14
Private Const WM_MOUSEWHEEL = &H20A
Private Const GWL_HINSTANCE = (-6)
Private udtlParamStuct As MSLLHOOKSTRUCT
' permet de savoir si le hook est activé ou pas
Public plHooking As Long
' sera associé à votre ComboBox/ListBox
Public CtrlHooked As Object
'
Private Function GetHookStruct(ByVal lParam As Long) As MSLLHOOKSTRUCT
    CopyMemory VarPtr(udtlParamStuct), lParam, LenB(udtlParamStuct)
    GetHookStruct = udtlParamStuct
End Function
Private Function LowLevelMouseProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    'en cas de mouvement très rapide,
    'évitons les crash en désactivant les erreurs
    On Error Resume Next
    If (nCode = HC_ACTION) Then
        If wParam = WM_MOUSEWHEEL Then
            LowLevelMouseProc = True
            With CtrlHooked
            ' déplace l'ascenseur en fonction de la molette
                ' l'info est stockée dans lParam
                If GetHookStruct(lParam).mouseData > 0 Then
                    .TopIndex = .TopIndex - 3
          ' =================================================== ADAPTATION
          ALBUM.Frame1.ScrollTop = .TopIndex * 10
          ' ================================================== ADAPTATION
                Else
                    .TopIndex = .TopIndex + 3
          ' ===================================================
          ALBUM.Frame1.ScrollTop = .TopIndex * 10
          ' ==================================================
                End If
            End With
        End If
        Exit Function
    End If
    LowLevelMouseProc = CallNextHookEx(0&, nCode, wParam, ByVal lParam)
    On Error GoTo 0
End Function
Public Sub HookMouse(ByVal ControlToScroll As Object, ByVal SheetOrForm As OWNER, Optional ByVal FormName As String)
    Dim hWnd As Long
    Dim hWnd_App As Long
    Dim hWnd_Desk As Long
    Dim hWnd_Sheet As Long
    Dim hWnd_UserForm As Long
    Const VBA_EXCEL_CLASSNAME = "XLMAIN"
    Const VBA_EXCELSHEET_CLASSNAME = "EXCEL7"
    Const VBA_EXCELWORKBOOK_CLASSNAME = "XLDESK"
    Const VBA_USERFORM_CLASSNAME = "ThunderDFrame"
    ' active le hook s'il n'avait pas déjà été activé
    If plHooking < 1 Then
        ' retourne l'handle d'excel
        hWnd_App = FindWindow(VBA_EXCEL_CLASSNAME, vbNullString)
        Select Case SheetOrForm
        Case eSHEET
            'trouve son fils
            hWnd_Desk = FindWindowEx(hWnd_App, 0&, VBA_EXCELWORKBOOK_CLASSNAME, vbNullString)
            'trouve celui de la feuille
            hWnd_Sheet = FindWindowEx(hWnd_Desk, 0&, VBA_EXCELSHEET_CLASSNAME, vbNullString)
            hWnd = hWnd_Sheet
        Case eUSERFORM
            'trouve la UserForm
            hWnd_UserForm = FindWindowEx(hWnd_App, 0&, VBA_USERFORM_CLASSNAME, FormName)
            If hWnd_UserForm = 0 Then
                hWnd_UserForm = FindWindow(VBA_USERFORM_CLASSNAME, FormName)
            End If
            hWnd = hWnd_UserForm
        End Select
        Set CtrlHooked = ControlToScroll
        ' il n'y a pas de hInstance d'application, alors on utilise GetWindowLong pour obtenir l'hInstance
        plHooking = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, GetWindowLong(hWnd, GWL_HINSTANCE), 0)
        Debug.Print Timer, "Hook ON"
    End If
End Sub
Public Sub UnHookMouse()
    ' désactive le hook s'il existe
    If plHooking <> 0 Then
        UnhookWindowsHookEx plHooking
        plHooking = 0
        Set CtrlHooked = Nothing
        Debug.Print Timer, "Hook OFF"
    End If
End Sub

Mais je n'arrive pas à le faire fonctionné. Je sais qu'il à l'aire d’utiliser une liste box mais je comprend pas pourquoi. Si vous avez des idée même qui n'on rien avoir avec le module dite moi tout ^^.

Le 07/08/2019 à 19:19

Bonjour,

Est-ce que tu peux joindre ton classeur de test ?

Le 08/08/2019 à 08:30

Wooooo, ce matin en faisant des recherche sur stack overflow je suis tomber sur un truc absolument génial.

C'est un projet git hub qui et justement là pour faire scroller n'importe quoi dans un user form avec la souris. En plus il est terriblement simple à utiliser.

Après avoir installer le module et le module de classe du projet, il n'y a qu'à faire sa dans le UserForm_Initialize :

Private Sub UserForm_Initialize()

    Me.StartUpPosition = 0
    Me.Left = Application.Left + Application.Width / 2 - Me.Width / 2
    Me.Top = Application.Top + Application.Height / 2 - Me.Height / 2
    HookMouseToForm Me

End Sub

Et voilà toute les frams et combo box réagisse au scrolling de la souris

Voici le lien du guit hub : https://github.com/cristianbuse/VBA-UserForm-MouseScroll

Et au cas ou sont module soit perdu, je vous et mis sont workbook de test en pièce jointe.

332vba-userform-mousescroll-demo.xlsm (78.39 Ko)
Le 08/08/2019 à 09:02

Salut,

Ci-joint, dis-moi si ça le fait, les "crochetages" ce n'est jamais facile

191testscrollmodule.xlsm (55.03 Ko)
Le 08/08/2019 à 09:03

Zut, j'ai loupé ton dernier message, je vais regarder ça... super !

Le 08/08/2019 à 09:04

merci quand même ^^

Mais comme tu à vue j'ai trouver un truc parfait pour faire se que je voulais faire

En plus sa peut être utile à tous le monde sur le forum

Je vais peut être faire un tuto

Le 08/08/2019 à 09:35

Un tuto c'est toujours une bonne initiative. J'ai testé le module que tu as trouvé, il est vraiment bien, celui que je t'ai proposé permet aussi de scroller horizontalement en maintenant la touche ctrl enfoncée. C'est la seule amélioration que j'y vois

Le 08/08/2019 à 10:36

Il le permet aussi avec shift + scrollwheel

Rechercher des sujets similaires à "scroller fram mollette souris"