compile error 64 bit - Mouse scroll code

Mikeymike_W

Board Regular
Joined
Feb 25, 2016
Messages
171
Hi,
This code allows me to use the scroll wheel on my userforms.
I've been using this bit of code successfully but now i have a 64 bit system and its throwing up the following error:

Compile error:
The code in this project must be updated for use on 64-bit systems.
Please review and update Declare statements and then mark them with the PtrSafe attribute.

I'm not entirely literate in vba. I assume i need to change "user32" to "user64"?
I know i also need to put in "ptrsafe" in some locations but i'm not sure where. From research i also saw that some declarations need to be changed "Long" to "LongPtr"... its a minefield and i've no idea how to change it so it keeps working on 32 and 64 bit system.

I hope that someone can help!

VBA Code:
Option Explicit
' Based on code from Peter Thornton here:
' http://social.msdn.microsoft.com/Forums/en-US/7d584120-a929-4e7c-9ec2-9998ac639bea/mouse-scroll-in-userform-listbox-in-excel-2010?forum=isvvba
Private Type POINTAPI
 x As Long
 y As Long
End Type
Private Type MOUSEHOOKSTRUCT
 pt As POINTAPI
 hwnd As Long
 wHitTestCode As Long
 dwExtraInfo As Long
End Type
Private Declare Function FindWindow Lib "user32" _
 Alias "FindWindowA" ( _
 ByVal lpClassName As String, _
 ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32.dll" _
 Alias "GetWindowLongA" ( _
 ByVal hwnd As Long, _
 ByVal nIndex As Long) 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
Private Declare Function PostMessage Lib "user32.dll" _
 Alias "PostMessageA" ( _
 ByVal hwnd As Long, _
 ByVal wMsg As Long, _
 ByVal wParam As Long, _
 ByVal lParam As Long) As Long
Private Declare Function WindowFromPoint Lib "user32" ( _
 ByVal xPoint As Long, _
 ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32.dll" ( _
 ByRef lpPoint As POINTAPI) As Long
Private Const WH_MOUSE_LL As Long = 14
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const HC_ACTION As Long = 0
Private Const GWL_HINSTANCE As Long = (-6)
Private Const WM_KEYDOWN As Long = &H100
Private Const WM_KEYUP As Long = &H101
Private Const VK_UP As Long = &H26
Private Const VK_DOWN As Long = &H28
Private Const WM_LBUTTONDOWN As Long = &H201
Private Const cSCROLLCHANGE As Long = 40
Private mLngMouseHook As Long
Private mFormHwnd As Long
Private mbHook As Boolean
Dim mForm As Object
Sub HookFormScroll(oForm As Object)
 Dim lngAppInst As Long
 Dim hwndUnderCursor As Long
 Set mForm = oForm
 hwndUnderCursor = FindWindow("ThunderDFrame", oForm.Caption)
Debug.Print "Form window: " & hwndUnderCursor
 If mFormHwnd <> hwndUnderCursor Then
 UnhookFormScroll
Debug.Print "Unhook old proc"
 mFormHwnd = hwndUnderCursor
 lngAppInst = GetWindowLong(mFormHwnd, GWL_HINSTANCE)
 If Not mbHook Then
 mLngMouseHook = SetWindowsHookEx( _
 WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)
 mbHook = mLngMouseHook <> 0
 If mbHook Then Debug.Print "Form hooked"
 End If
 End If
End Sub
Sub UnhookFormScroll()
 If mbHook Then
 UnhookWindowsHookEx mLngMouseHook
 mLngMouseHook = 0
 mFormHwnd = 0
 mbHook = False
 End If
End Sub
Private Function MouseProc( _
 ByVal nCode As Long, ByVal wParam As Long, _
 ByRef lParam As MOUSEHOOKSTRUCT) As Long
 On Error GoTo errH 'Resume Next
 If (nCode = HC_ACTION) Then
Debug.Print "action"
Debug.Print "right window"
 If wParam = WM_MOUSEWHEEL Then
Debug.Print "mouse scroll"
 MouseProc = True
 If lParam.hwnd > 0 Then
 mForm.ScrollTop = Application.Max(0, mForm.ScrollTop - cSCROLLCHANGE)
 Else
 mForm.ScrollTop = Application.Min(mForm.ScrollHeight - mForm.InsideHeight, mForm.ScrollTop + cSCROLLCHANGE)
 End If
 Exit Function
 End If
 End If
 MouseProc = CallNextHookEx( _
 mLngMouseHook, nCode, wParam, ByVal lParam)
 Exit Function
errH:
 UnhookFormScroll
End Function
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

diddi

Well-known Member
Joined
May 20, 2004
Messages
3,307
Office Version
  1. 2010
Platform
  1. Windows
you need to declare your API functions as PtrSafe
go through your code and pick out all the API . and edit as per example

VBA Code:
Private Declare Function FindWindow Lib "user32" ....
Private Declare PtrSafe Function FindWindow Lib "user32" ....

thats it!




VBA Code:
Option Explicit
' Based on code from Peter Thornton here:
' http://social.msdn.microsoft.com/Forums/en-US/7d584120-a929-4e7c-9ec2-9998ac639bea/mouse-scroll-in-userform-listbox-in-excel-2010?forum=isvvba

Private Declare PtrSafe Function FindWindow Lib "user32" _
    Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32.dll" _
    Alias "GetWindowLongA" ( _
    ByVal hwnd As Long, _
    ByVal nIndex As Long) 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
Private Declare PtrSafe Function PostMessage Lib "user32.dll" _
    Alias "PostMessageA" ( _
    ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long
Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
    ByVal xPoint As Long, _
    ByVal yPoint As Long) As Long
Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" ( _
    ByRef lpPoint As POINTAPI) As Long
    
Private Const WH_MOUSE_LL As Long = 14
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const HC_ACTION As Long = 0
Private Const GWL_HINSTANCE As Long = (-6)
Private Const WM_KEYDOWN As Long = &H100
Private Const WM_KEYUP As Long = &H101
Private Const VK_UP As Long = &H26
Private Const VK_DOWN As Long = &H28
Private Const WM_LBUTTONDOWN As Long = &H201
Private Const cSCROLLCHANGE As Long = 40
Private mLngMouseHook As Long
Private mFormHwnd As Long
Private mbHook As Boolean

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type MOUSEHOOKSTRUCT
    pt As POINTAPI
    hwnd As Long
    wHitTestCode As Long
    dwExtraInfo As Long
End Type

Dim mForm As Object

Sub HookFormScroll(oForm As Object)
    Dim lngAppInst As Long
    Dim hwndUnderCursor As Long
    Set mForm = oForm
    hwndUnderCursor = FindWindow("ThunderDFrame", oForm.Caption)
    Debug.Print "Form window: " & hwndUnderCursor
    If mFormHwnd <> hwndUnderCursor Then
        UnhookFormScroll
        Debug.Print "Unhook old proc"
        mFormHwnd = hwndUnderCursor
        lngAppInst = GetWindowLong(mFormHwnd, GWL_HINSTANCE)
        If Not mbHook Then
            mLngMouseHook = SetWindowsHookEx( _
            WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)
            mbHook = mLngMouseHook <> 0
            If mbHook Then Debug.Print "Form hooked"
        End If
    End If
End Sub

Sub UnhookFormScroll()
    If mbHook Then
        UnhookWindowsHookEx mLngMouseHook
        mLngMouseHook = 0
        mFormHwnd = 0
        mbHook = False
    End If
End Sub

Private Function MouseProc( _
    ByVal nCode As Long, ByVal wParam As Long, _
    ByRef lParam As MOUSEHOOKSTRUCT) As Long
    
    On Error GoTo errH 'Resume Next
    If (nCode = HC_ACTION) Then
        Debug.Print "action"
        Debug.Print "right window"
        If wParam = WM_MOUSEWHEEL Then
            Debug.Print "mouse scroll"
            MouseProc = True
            If lParam.hwnd > 0 Then
                mForm.ScrollTop = Application.Max(0, mForm.ScrollTop - cSCROLLCHANGE)
            Else
                mForm.ScrollTop = Application.Min(mForm.ScrollHeight - mForm.InsideHeight, mForm.ScrollTop + cSCROLLCHANGE)
            End If
            Exit Function
        End If
    End If
    MouseProc = CallNextHookEx( _
    mLngMouseHook, nCode, wParam, ByVal lParam)
    Exit Function
errH:
    UnhookFormScroll
End Function
 
Last edited:
Solution

Mikeymike_W

Board Regular
Joined
Feb 25, 2016
Messages
171
you need to declare your API functions as PtrSafe
go through your code and pick out all the API . and edit as per example

VBA Code:
Private Declare Function FindWindow Lib "user32" ....
Private Declare PtrSafe Function FindWindow Lib "user32" ....

thats it!




VBA Code:
Option Explicit
' Based on code from Peter Thornton here:
' http://social.msdn.microsoft.com/Forums/en-US/7d584120-a929-4e7c-9ec2-9998ac639bea/mouse-scroll-in-userform-listbox-in-excel-2010?forum=isvvba

Private Declare PtrSafe Function FindWindow Lib "user32" _
    Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32.dll" _
    Alias "GetWindowLongA" ( _
    ByVal hwnd As Long, _
    ByVal nIndex As Long) 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
Private Declare PtrSafe Function PostMessage Lib "user32.dll" _
    Alias "PostMessageA" ( _
    ByVal hwnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long
Private Declare PtrSafe Function WindowFromPoint Lib "user32" ( _
    ByVal xPoint As Long, _
    ByVal yPoint As Long) As Long
Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" ( _
    ByRef lpPoint As POINTAPI) As Long
   
Private Const WH_MOUSE_LL As Long = 14
Private Const WM_MOUSEWHEEL As Long = &H20A
Private Const HC_ACTION As Long = 0
Private Const GWL_HINSTANCE As Long = (-6)
Private Const WM_KEYDOWN As Long = &H100
Private Const WM_KEYUP As Long = &H101
Private Const VK_UP As Long = &H26
Private Const VK_DOWN As Long = &H28
Private Const WM_LBUTTONDOWN As Long = &H201
Private Const cSCROLLCHANGE As Long = 40
Private mLngMouseHook As Long
Private mFormHwnd As Long
Private mbHook As Boolean

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type MOUSEHOOKSTRUCT
    pt As POINTAPI
    hwnd As Long
    wHitTestCode As Long
    dwExtraInfo As Long
End Type

Dim mForm As Object

Sub HookFormScroll(oForm As Object)
    Dim lngAppInst As Long
    Dim hwndUnderCursor As Long
    Set mForm = oForm
    hwndUnderCursor = FindWindow("ThunderDFrame", oForm.Caption)
    Debug.Print "Form window: " & hwndUnderCursor
    If mFormHwnd <> hwndUnderCursor Then
        UnhookFormScroll
        Debug.Print "Unhook old proc"
        mFormHwnd = hwndUnderCursor
        lngAppInst = GetWindowLong(mFormHwnd, GWL_HINSTANCE)
        If Not mbHook Then
            mLngMouseHook = SetWindowsHookEx( _
            WH_MOUSE_LL, AddressOf MouseProc, lngAppInst, 0)
            mbHook = mLngMouseHook <> 0
            If mbHook Then Debug.Print "Form hooked"
        End If
    End If
End Sub

Sub UnhookFormScroll()
    If mbHook Then
        UnhookWindowsHookEx mLngMouseHook
        mLngMouseHook = 0
        mFormHwnd = 0
        mbHook = False
    End If
End Sub

Private Function MouseProc( _
    ByVal nCode As Long, ByVal wParam As Long, _
    ByRef lParam As MOUSEHOOKSTRUCT) As Long
   
    On Error GoTo errH 'Resume Next
    If (nCode = HC_ACTION) Then
        Debug.Print "action"
        Debug.Print "right window"
        If wParam = WM_MOUSEWHEEL Then
            Debug.Print "mouse scroll"
            MouseProc = True
            If lParam.hwnd > 0 Then
                mForm.ScrollTop = Application.Max(0, mForm.ScrollTop - cSCROLLCHANGE)
            Else
                mForm.ScrollTop = Application.Min(mForm.ScrollHeight - mForm.InsideHeight, mForm.ScrollTop + cSCROLLCHANGE)
            End If
            Exit Function
        End If
    End If
    MouseProc = CallNextHookEx( _
    mLngMouseHook, nCode, wParam, ByVal lParam)
    Exit Function
errH:
    UnhookFormScroll
End Function
Hi Diddy,

Thank you so much for your help!
i'll try this out on the 64bit system and get back to you, works fine on the 32bit.

I really appreciate your help,

Mike
 

diddi

Well-known Member
Joined
May 20, 2004
Messages
3,307
Office Version
  1. 2010
Platform
  1. Windows
yes it is backwards compatible... if it works properly, mark as a solution so others can find it easily :)
your welcome
 

Watch MrExcel Video

Forum statistics

Threads
1,130,316
Messages
5,641,484
Members
417,211
Latest member
loadius

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top