Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Membre régulier
    Profil pro
    Inscrit en
    octobre 2009
    Messages
    226
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : octobre 2009
    Messages : 226
    Points : 108
    Points
    108

    Par défaut Incompatible avec Office 2016 (64) - Pourquoi ?

    Bonjour,

    Voici un morceau de code qui fonctionne très bien sous Excel 2017,2013 et 2016 32bits mais pas sous 64bits...

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    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
    Je sais qu'il y a des différences entre le code 32 et 64 bits comme par exemple les Declare Function qui en 64bits doivent être Declare PtrSafe Function, mais là, je ne trouve pas ce que je dois changer pour rendre mon code compatible 64bits...

    Ps : pour info, le code active le scroll souris dans ma box

    Merci d'avance pour votre aide :-)

    Pour info, voici tout le module

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    #If Win64 Then
    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
    #Else
    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
    #End If
     
    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 message d'erreur affiche cette ligne : plHooking = SetWindowsHookEx(WH_MOUSE_LL, AddressOf LowLevelMouseProc, GetWindowLong(hwnd, GWL_HINSTANCE), 0)

  2. #2
    Débutant  
    Avatar de patricktoulon
    Homme Profil pro
    cuisiniste
    Inscrit en
    avril 2009
    Messages
    15 329
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : avril 2009
    Messages : 15 329
    Points : 13 253
    Points
    13 253
    Billets dans le blog
    7

    Par défaut re

    re
    bonjour
    pour commencer
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    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
    je garantie rien chez moi office 64 est banni
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  3. #3
    Membre régulier
    Profil pro
    Inscrit en
    octobre 2009
    Messages
    226
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : octobre 2009
    Messages : 226
    Points : 108
    Points
    108

    Par défaut

    Salut,

    LongPtr semble accepté en 64bits, mais les lignes de codes qui fonctionnaient très bien avec Long en 64bits ne fonctionnent plus maintenant donc... ce n'est pas ça...

    EDIT : Je vais essayer avec LonLong

    EDIT 2 : J'ai maintenant "Incompatibilité de TYPE" sur : hWnd_App = FindWindow(VBA_EXCEL_CLASSNAME, vbNullString)

    EDIT 3 : J'ai trouvé ceci (https://www.developpez.net/forums/d1...s-api-64-bits/), mais comment reconnaitre les "pointeurs" ?

    EDIT 4 : Je viens de tomber sur un site qui me conseil plutôt ceci... je vais tester, mais là, je suis perdu...

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    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 LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Private Declare PtrSafe Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As LongPtr) As Long

  4. #4
    Débutant  
    Avatar de patricktoulon
    Homme Profil pro
    cuisiniste
    Inscrit en
    avril 2009
    Messages
    15 329
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : avril 2009
    Messages : 15 329
    Points : 13 253
    Points
    13 253
    Billets dans le blog
    7

    Par défaut re

    re
    moi aussi je me perd en 64 c'est bien pour ca et plein d'autre chose que j'en veux pas
    d'autant plus que ca m'oblige a allumer le pc portable qui est le seul avec un office 64 et 2016 en plus
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

  5. #5
    Responsable Access

    Avatar de Arkham46
    Profil pro
    Inscrit en
    septembre 2003
    Messages
    5 552
    Détails du profil
    Informations personnelles :
    Localisation : France, Loiret (Centre)

    Informations forums :
    Inscription : septembre 2003
    Messages : 5 552
    Points : 12 485
    Points
    12 485

    Par défaut

    Bonsoir,

    https://arkham46.developpez.com/arti...ice/vba64bits/
    Il y a un lien vers un fichier microsoft avec les déclarations des fonctions en 64bits (pas toutes mais beaucoup).

    Et puis il faut lire tout le reste de l'article.

    Le edit 4 : les déclarations sont complètement fausses.
    Attention aux declarations 64bits, il y a de nombreuses erreurs sur internet.

    Sinon mon conseil : virer tout le code...
    Il ne faut pas utiliser ce genre de code non maîtrisé.
    Mieux vieux se passer de la molette que d'avoir une appli qui crashe.
    C'est dommage c'est ainsi.

  6. #6
    Membre régulier
    Profil pro
    Inscrit en
    octobre 2009
    Messages
    226
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : octobre 2009
    Messages : 226
    Points : 108
    Points
    108

    Par défaut

    Voilà, après quelques modifications... la fenêtre s'ouvre, la liste apparait dans la box, mais si je fais un scroll souris cela plante avec le message suivant : "Erreur Automation - Une exception s'est produite"

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    #If Win64 Then
    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 LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Private Declare PtrSafe Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As LongPtr) As Long
    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 Long
    Private Declare PtrSafe Function CallNextHookEx Lib "User32" (ByVal hHook As LongPtr, ByVal nCode As LongPtr, ByVal wParam As LongPtr, lParam As Any) As Long
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "User32" (ByVal hHook As LongPtr) As Long
    #Else
    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
    #End If
     
    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
    Une idée...

    EDIT : J'ai trouvé, maintenant, je dois trouver comment faire cohabiter les deux...

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    #If Win64 Then
    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 LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    Private Declare PtrSafe Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As LongPtr) As Long
    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 Long
    Private Declare PtrSafe Function CallNextHookEx Lib "User32" (ByVal hHook As LongPtr, ByVal nCode As LongPtr, ByVal wParam As LongPtr, lParam As Any) As Long
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "User32" (ByVal hHook As LongPtr) As Long
    #Else
    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
    #End If
     
    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 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 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 problème était là... LongPtr et non Long...

    Private Function GetHookStruct(ByVal lParam As LongPtr) As MSLLHOOKSTRUCT
    ...
    Private Function LowLevelMouseProc(ByVal nCode As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
    ...

    Donc commenr dire : Si Win64 then Private Function GetHookStruct(ByVal lParam As LongPtr) As MSLLHOOKSTRUCT si non Private Function GetHookStruct(ByVal lParam As Long) As MSLLHOOKSTRUCT

    Je vais tester :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    #If Win64 Then
    Private Function GetHookStruct(ByVal lParam As LongPtr) As MSLLHOOKSTRUCT
    #Else
    Private Function GetHookStruct(ByVal lParam As Long) As MSLLHOOKSTRUCT
    #End if

  7. #7
    Membre régulier
    Profil pro
    Inscrit en
    octobre 2009
    Messages
    226
    Détails du profil
    Informations personnelles :
    Localisation : Belgique

    Informations forums :
    Inscription : octobre 2009
    Messages : 226
    Points : 108
    Points
    108

    Par défaut

    Ca fonctionne avec...
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    #If Win64 Then
    Private Function GetHookStruct(ByVal lParam As LongPtr) As MSLLHOOKSTRUCT
    #Else
    Private Function GetHookStruct(ByVal lParam As Long) As MSLLHOOKSTRUCT
    #End if
    Encore merci

  8. #8
    Responsable Access

    Avatar de Arkham46
    Profil pro
    Inscrit en
    septembre 2003
    Messages
    5 552
    Détails du profil
    Informations personnelles :
    Localisation : France, Loiret (Centre)

    Informations forums :
    Inscription : septembre 2003
    Messages : 5 552
    Points : 12 485
    Points
    12 485

    Par défaut

    Bonjour,

    Désolé mais votre code est truffé d'erreurs.
    Cela fonctionne peut etre aujourd'hui.
    Bonne chance pour demain.

    Programmer les API pour 64 bits n'est pas une histoire de hasard, sinon je n'aurais pas pris la peine d'écrire un article sur le sujet.

    Je me devais de réagir pour ne pas laisser croire que le code ainsi modifié peut fonctionner sans risque.

    Cdt.

  9. #9
    Expert éminent

    Homme Profil pro
    Développeur .NET
    Inscrit en
    janvier 2012
    Messages
    4 792
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 62
    Localisation : Canada

    Informations professionnelles :
    Activité : Développeur .NET
    Secteur : Finance

    Informations forums :
    Inscription : janvier 2012
    Messages : 4 792
    Points : 9 937
    Points
    9 937
    Billets dans le blog
    31

    Par défaut

    Et puis la constante de compilation à utiliser c'est VBA7 et pas Win64
    À ma connaissance, le seul personnage qui a été diagnostiqué comme étant allergique au mot effort. c'est Gaston Lagaffe.

    Ô Saint Excel, Grand Dieu de l'Inutile.

    Excel n'a jamais été, n'est pas et ne sera jamais un SGBD, c'est pour cela que Excel s'appelle Excel et ne s'appelle pas Access junior.

  10. #10
    Responsable Access

    Avatar de Arkham46
    Profil pro
    Inscrit en
    septembre 2003
    Messages
    5 552
    Détails du profil
    Informations personnelles :
    Localisation : France, Loiret (Centre)

    Informations forums :
    Inscription : septembre 2003
    Messages : 5 552
    Points : 12 485
    Points
    12 485

    Par défaut

    Citation Envoyé par clementmarcotte Voir le message
    Et puis la constante de compilation à utiliser c'est VBA7 et pas Win64
    Je met un bémol :

    Vba7 signifie office 2010 ou plus (en gros).
    Win64 signifie 64bits.

    Dans de rare cas il est necessaire de distinguer sur win64 (souvent sur des tailles de structures, ou quelques api spécifiques 64bits ).
    Mais effectivement la plupart du temps vba7 suffit, sachant qu'un longPtr devient long ou longptr en fonction du "bitage".

    Donc oui VBA7 sauf exception.

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 6
    Dernier message: 29/03/2018, 14h33
  2. Réponses: 4
    Dernier message: 09/03/2018, 19h43
  3. Compatibilité SP 2013 avec Office 2016
    Par bapt_91 dans le forum SharePoint
    Réponses: 0
    Dernier message: 26/01/2017, 17h03
  4. [WD-MAC 2011] Supprimer des dossiers en VBA avec Office Mac 2016
    Par Pierrea4564 dans le forum Word
    Réponses: 1
    Dernier message: 31/05/2016, 16h38
  5. Word.Application avec office 2016 VB.NET
    Par aiglelibre dans le forum Windows Forms
    Réponses: 1
    Dernier message: 21/12/2015, 20h52

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo