Convertir un code 32 bits en 64 bits

Le 10/07/2021 à 10:54

bonjour à toutes & tous,

je viens de passer sous office 365 64 bits & j'ai un problème de compatibilité avec une macro. Ce code n'ait pas de moi mais trouvés sur le net.

le premier permet d'utiliser la molette dans les ListBox & ComboBox. j'ai modifié en ajoutant PtrSafe dans Option Explicit mais le code bloc plus loin "Public Sub HookMouse(ByVal ControlToScroll As Object, ByVal SheetOrForm As OWNER, Optional ByVal FormName As String)" et je suis perdu.

Si vous avez une solution je suis preneur.

'------------------------------------------------------------------------------------------------------------
' Module    : modHookWheelMouse
' Date      : 27/05/2012
' But       : Permet d'utiliser la molette de la souris avec ComboBox ou ListBox dans une feuille ou UserForm
'------------------------------------------------------------------------------------------------------------

Option Explicit

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe 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 PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
Private Declare PtrSafe 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 PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare PtrSafe 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
                Else
                    .TopIndex = .TopIndex + 3
                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
Le 10/07/2021 à 16:38

Bonjour,

Ajouter PtrSafe ne suffit pas, il faut en général modifier les types de fonction déclarés en Long, en LongPtr.

A priori

Option Explicit

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As LongPtr, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As LongPtr
Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As LongPtr
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr

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 LongPtr

    '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
                Else
                    .TopIndex = .TopIndex + 3
                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 LongPtr
    Dim hWnd_App As LongPtr
    Dim hWnd_Desk As LongPtr
    Dim hWnd_Sheet As LongPtr
    Dim hWnd_UserForm As LongPtr
    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
Le 10/07/2021 à 18:03

bonjour et merci pour ton aide thev,

j'ai effectué la modif. Mais maintenant, j'ai une erreur de compilation: incompatibilité de type AddressOf LowLevelMouseProc

Le 10/07/2021 à 19:21

Bonjour,

il faut sans doute passer toutes les variables Long en LongPtr

Option Explicit

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As LongPtr) As LongPtr
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As LongPtr, ByVal Source As LongPtr, ByVal Length As LongPtr)
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As LongPtr, ByVal lpfn As LongPtr, ByVal hMod As LongPtr, ByVal dwThreadId As LongPtr) As LongPtr
Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As LongPtr, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr

Public Enum OWNER
    eSHEET = 1
    eUSERFORM = 2
End Enum

Private Type POINTAPI
    X As LongPtr
    Y As LongPtr
End Type

Private Type MSLLHOOKSTRUCT
    pt As POINTAPI
    mouseData As LongPtr
    flags As LongPtr
    time As LongPtr
    dwExtraInfo As LongPtr
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 LongPtr

' sera associé à votre ComboBox/ListBox
Public CtrlHooked As Object
'

Private Function GetHookStruct(ByVal lParam As LongPtr) As MSLLHOOKSTRUCT
    CopyMemory VarPtr(udtlParamStuct), lParam, LenB(udtlParamStuct)
    GetHookStruct = udtlParamStuct
End Function

Private Function LowLevelMouseProc(ByVal nCode As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

    '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
                Else
                    .TopIndex = .TopIndex + 3
                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 LongPtr
    Dim hWnd_App As LongPtr
    Dim hWnd_Desk As LongPtr
    Dim hWnd_Sheet As LongPtr
    Dim hWnd_UserForm As LongPtr
    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 GetWindowLongPtr pour obtenir l'hInstance
        plHooking = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, GetWindowLongPtr(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
Le 10/07/2021 à 21:04

merci thev,

apparemment tu as raison, je vais tester avec un de mes fichiers. reste un problème de taille: comment rendre le fichier compatible 32 & 64 bits?

Le 10/07/2021 à 22:15

Bonjour,

Comme ceci :

#If VBA7 Then
    'Apis windows 64 bits

    'variables API 64 bits

#Else
   'Apis windows 32 bits

   'variables API 32 bits

#End If
Le 10/07/2021 à 22:30

Ce qui devrait donner

Option Explicit

#If VBA7 Then
    'Apis windows 64 bits
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As LongPtr) As LongPtr
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As LongPtr, ByVal Source As LongPtr, ByVal Length As LongPtr)
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As LongPtr, ByVal lpfn As LongPtr, ByVal hMod As LongPtr, ByVal dwThreadId As LongPtr) As LongPtr
Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As LongPtr, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr

    'variables API 64 bits

    ' permet de savoir si le hook est activé ou pas
    Public plHooking As LongPtr

#Else

   'Apis windows 32 bits
    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

    'variables API 32 bits

    ' permet de savoir si le hook est activé ou pas
    Public plHooking As Long

#End If

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

Public Enum OWNER
    eSHEET = 1
    eUSERFORM = 2
End Enum

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

' 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
                Else
                    .TopIndex = .TopIndex + 3
                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)

    #If VBA7 Then
        Dim hWnd As LongPtr
        Dim hWnd_App As LongPtr
        Dim hWnd_Desk As LongPtr
        Dim hWnd_Sheet As LongPtr
        Dim hWnd_UserForm As LongPtr
    #Else
        Dim hWnd As Long
        Dim hWnd_App As Long
        Dim hWnd_Desk As Long
        Dim hWnd_Sheet As Long
        Dim hWnd_UserForm As Long
    #End If

    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

Print
Le 10/07/2021 à 22:37

A noter tout de même, d'après mon expérience, que certaines variables en 64 bits doivent continuer à être déclarées en "Long" pour que ça fonctionne, en particulier les "Private Type"

Le 10/07/2021 à 22:55

Bonjour thev,

As-tu de la documentation sur la syntaxe #If VBA7 Then ? Je suis surpris qu'une telle syntaxe existe, à moins qu'il ne s'agisse d'un commentaire ?

Par avance merci !

Cdlt,

PS : Long comme code pour un clic molette .. Chapeau !

Le 10/07/2021 à 23:59

Salut à tous,

Pfff moi j'ai tellement eu de problèmes avec des compléments non pris en charge des déclarations non reconnues car certaines doivent rester en Long, d'autres dans la même déclaration passe en LongPtr, du coup j'ai désinstallé Office 365 et je l'ai réinstallé en 32 bits. Je sais c'est pas cool...

Le 11/07/2021 à 09:33

Bonjour,

@Ergatomine

Je n'ai pas de documentation particulière sur #If VBA7 . Ce n'est pas un commentaire, c'est en fait une instruction n'agissant qu'à la compilation, et non à l’exécution.

C'est vrai que ce code me parait copieux pour gérer une molette de souris. Le premier point est qu'il gère à la fois le contrôle ActiveX d'une feuille ou d'un formulaire. Le deuxième point est qu'il gère des fenêtres standard dans Excel : formulaire ou feuille. Personnellement, je ne me suis servi de ces APIs que pour gérer des fenêtres non standard comme celle de l'ouverture d'un fichier PDF. Il existe peut être une solution plus simple mais celle-ci a le mérite de fonctionner.

@Jean-Paul

Pfff moi j'ai tellement eu de problèmes avec des compléments non pris en charge des déclarations non reconnues car certaines doivent rester en Long, d'autres dans la même déclaration passe en LongPtr,

C'est vrai, mais il ne faut pas pour autant baisser les bras. Après les essais d'exécution, je suis toujours arrivé à identifier celles devant rester en Long. En fait, la règle est que les variables de type Adresse mémoire doivent passer en LongPtr et celles de type Data rester en Long. D'autant que selon le contexte, on n'a pas forcément la main sur le choix du 64 bits.

Le 11/07/2021 à 11:41

bonjour thev,

tout d'abord merci pour ton aide.

j'ai essayé le code, ça plante. je joint le fichier originale modifié. attention ça plante assez dur.

7molette-pour-combo-listbox-sur-feuil-et-userform-test.xlsm (38.57 Ko)
Le 11/07/2021 à 18:28

Bonjour,

ci-joint fichier

31molette-pour-combo-listbox-sur-feuil-et-userform-test1.xlsm (36.61 Ko)
Le 11/07/2021 à 18:48

merci pour le temps que tu passes à m'aider. C'est vraiment sympa.

j'ai testé le fichier joint, il y a un souci, mais tu n'as peut-être pas le même avec ta version. le scroll ne se fait que vers le bas, impossible de remonter dans la liste.

Le 11/07/2021 à 19:52
j'ai testé le fichier joint, il y a un souci, mais tu n'as peut-être pas le même avec ta version. le scroll ne se fait que vers le bas,impossible de remonter dans la liste.
Je n'ai pas effectivement ce problème.
Le 11/07/2021 à 20:50

merci pour ton retour.

Je crois que j'ai suffisamment abusé de ton temps. De plus si tu n'as pas le problème, il sera difficile de le résoudre . je pense que je vais supprimer cette partie du code, c'est un confort bien agréable pour les listes très longues, d'ailleurs je ne comprends pas pourquoi les équipes de programmeurs d'Excel ne l'intègre pas directement comme cela est le cas dans Sheets de GOOGLE .

Ça me donne une idée, il existe peut-être un moyen de filtrer une liste plutôt que de scroller?

En tout cas, je te remercie pour ton aide et ta patience. Il est très appréciable de trouver de l'aide quand on est pas très doué avec les macros. Je vais laisser ce post encore un peu ouvert pour que d'autres personnes puissent profiter de tes aides.

Bonne soirée.

Le 11/07/2021 à 20:55

Bonjour à tous,

Excel 365 32 bits ...

J'ai le même souci > j'actionne la roulette de la souris vers le bas ou vers le haut > le défilement ne se fait que vers le bas ...

ric

Le 11/07/2021 à 21:01

bonjour Ric,

je me sent moins seul du coup

Le 11/07/2021 à 22:36

Excel 365 32 bits ...

J'ai le même souci > j'actionne la roulette de la souris vers le bas ou vers le haut > le défilement ne se fait que vers le bas ...

En tout cas, ce n"est pas lié à la version 64 bits.

Le 11/07/2021 à 22:49

Bonjour à tous,

J'ai testé aussi sur une autre machine munie de Excel 365 64 bits > idem > vers le bas ...

ric

Rechercher des sujets similaires à "convertir code bits"