USD $50.00 - VBA code to capture mouse wheel rotation to update a cell row counter.

    This is not homework; I am 56. I program only for myself and the fun of it. I'm willing to pay if I can't do it on my own and can't find a solution in another way.


    I originally posted this help request, my first, on the free section of the site but haven't gotten any bites so I'm trying this out.


    This is my original post:
    I need to capture mouse wheel rotation steps in order to update a row counter in a cell of a sheet.
    I don't need to take complete control of the mouse (unless I have to), just read a parameter which tells me if the wheel has been moved up or down.
    I have Excel 2016 and Windows 10.
    Is it possible to do what I need? Does anyone have the VBA code to achieve it? (and a quick explanation of it, thanx)


    I was asked for more information, here it is:
    I'd like to be able to update a cell of a sheet where I have a row counter.
    By using Application.OnKey I already update that cell when the user presses PgUp/Dn and the Up/Down arrows by subtracting/adding 33 (it is the number of rows I show in a page) or 1 for the arrows. I'd like to do the same with the mouse wheel by adding or subtracting 3 (better yet the number in Settings/Mouse).
    I've seen code which lets the user scroll in a form but, because I'm a beginner, I understand little of that code therefore I can't change it.


    That's it.
    I'd add I have 32bit Windows 10 on a 64bit machine; one day I guess I'll upgrade to Windows 10 64 bit but for now....


    My requests, obiously except the code :) :
    1. a comment to explain what each function/sub does.
    2. where the code has to be put (Sheet, Module, ThisWorkBook).
    3. changes to be made if I upgrade to 64bit Windows 10.
    4. how to start the code; if possible i'd like to enable and disable it (which is, return the wheel to its normal use) by pressing for example an ActiveX button.


    Any further info/clarification required please ask.
    Thank you!
    Guido

    Hi Guido,


    To accomplish this you need to obtain the windows handle of the worksheet using the FindWindowEx API...


    (ADMIN EDIT TO MAKE THIS POINT MORE VISIBLE): Note : The WindowProc CallBack Function can cause Excel to crash if you go into the Visual Basic Editor so I would advise not using this when running the code.


    hwnd_XLApp = Application.hWnd
    hwnd_XLDesk = FindWindowEx(hwnd_XLApp, 0&, "XLDESK", vbNullString)
    hwnd_XLSheet = FindWindowEx(hwnd_XLDesk, 0&, "EXCEL7", ActiveWindow.Caption)


    Then you hook this into a Windows Callback Function using the CallWindowProc API...


    Hook hwnd_XLSheet
    .
    .
    ,
    WindowProc = CallWindowProc(lngPrevWndProc, lWnd, lMsg, wParam, lParam)


    In the WindowProc Callback Function you then test for the Mouse Wheel Event and call the procedure to handle the Mouse Wheel event...


    ' Test if the message is WM_MOUSEWHEEL
    If lMsg = WM_MOUSEWHEEL Then
    fwKeys = wParam And 65535
    zDelta = wParam / 65536
    xPos = lParam And 65535
    yPos = lParam / 65536
    ' Call the Procedure to handle the Mouse Wheel event
    MouseWheel fwKeys, zDelta, xPos, yPos
    End If


    ' zDelta: The value of the high-order word of wParam.
    ' Indicates the distance that the wheel is rotated, expressed in multiples or
    ' divisions of WHEEL_DELTA, which is 120. A positive value indicates that the
    ' wheel was rotated forward, away from the user. A negative value indicates
    ' that the wheel was rotated backward, toward the user.


    A zDelta value of 120 corresponds to 3 rows moved in my copy of Excel this can be changed by constant MOUSEWHEEL_ROWS_MOVED.


    ' +-----------------------------------------------------+
    ' | Procedure is called when the mouse wheel is moved |
    ' +-----------------------------------------------------+
    Public Sub MouseWheel(ByVal fwKeys As Long, ByVal zDelta As Long, ByVal xPos As Long, ByVal yPos As Long)


    ' Mouse Wheel moved forward away from the user
    If Sgn(zDelta) = 1 Then
    lngMouseWheelRowsScrolled = lngMouseWheelRowsScrolled - zDelta / 120 * MOUSEWHEEL_ROWS_MOVED
    End If


    ' Mouse Wheel moved backward towards the user
    If Sgn(zDelta) = -1 Then
    lngMouseWheelRowsScrolled = lngMouseWheelRowsScrolled + Abs(zDelta / 120 * MOUSEWHEEL_ROWS_MOVED)
    End If


    ' Top row reached
    If Sgn(lngMouseWheelRowsScrolled) = -1 Then lngMouseWheelRowsScrolled = 0


    ' Bottom row reached
    If lngMouseWheelRowsScrolled > 1048576 Then lngMouseWheelRowsScrolled = 1048576


    wsMouseScroll.Range("RowsScrolled") = lngMouseWheelRowsScrolled


    Application.StatusBar = "Mouse Wheel Rows Scrolled" & Str(lngMouseWheelRowsScrolled)


    End Sub


    The attached workbook excelcoding_mouse_wheel_scroll.xlsm should do what you want has been tested in Excel 2016 32Bit.


    Note : The WindowProc CallBack Function can cause Excel to crash if you go into the Visual Basic Editor so I would advise not using this when running the code.


    Regards,


    Tom Rowe..

    Hi Tom,
    Thank you for the code but I must be doing something wrong because neither the row counter cell nor the status bar are updated.
    Here is what I did:
    1. Downloaded excelcoding_mouse_wheel_scroll.
    2. Opened it; it is in protected view mode so in File/Information I enabled modifications. Then I enabled contents. No more messages from Excel.
    3. Clicked on the Mouse Wheel Scroll sheet.
    4. Clicked on the 'Mouse Wheel Activate' button which then shows 'Mouse Wheel Deactivate'; the message "Mouse Wheel Event Activated. Ensure....' is shown and I click ok.
    5. I scroll using the mouse wheel; the page scrolls but the counter in D2 shows zero and the status bar shows 'Mouse Wheel Rows Scrolled 0'.
    I ran the risk of crashing Excel and in View Code I put an interruption point in the module modMouseWheelScroll on the left of 'Public Sub MouseWheel...' then 'Private Function WindowProc...', got out of View Code, scrolled again but neither of them seem to be executed.
    I did the same for the worksheet wsMouseScroll on the left of 'Private Sub cmdMouseWheel_Click()' but when I clicked on the Mouse Wheel Activate/Deactivate button I entered the sub and could follow it line by line (F8).
    What is wrong Tom ?


    Guido

    Hi Guido,


    Strange it all works fine for me, see the screen shot below...


    [ATTACH=JSON]{"data-align":"none","data-size":"full","title":"ScreenHunter_67 Jun. 30 20.14.jpg","data-attachmentid":1204979}[/ATTACH]


    The only thing I can think of at the moment is that you may be running a different version of Excel to me, I have seen problems in the past with code working perfectly in one version of Excel but not another especially code that is using APIs. As I mentioned in my first post this was all tested in Excel 2016 32 Bit. I can test it in Excel 2010 32 Bit for you but not until Monday. In the meantime it will be useful if you can let me know what version of Excel you are using.


    Regards,


    Tom...

    [SIZE=13px][SIZE=12px][SIZE=16px]Hi Tom,[/SIZE][/SIZE][/SIZE]


    [SIZE=13px][SIZE=12px][SIZE=16px]In the attached document you can find screenshots of which Window, Mouse, Office, Excel I have.[/SIZE][/SIZE][/SIZE]


    [SIZE=13px][SIZE=12px][SIZE=16px]The information in the screenshots is in Italian; I assume formatting is much the same in English. As a general rule take off the last 1-3 letters and you have the English word or much of it. Anyway, if you’d like to have a translation just ask.[/SIZE][/SIZE][/SIZE]


    [SIZE=12px][SIZE=16px]If the screenshots are of no help I have a few questions in order to come to a solution:[/SIZE][/SIZE]


    [SIZE=13px]1. A[/SIZE][SIZE=13px][SIZE=12px][SIZE=16px]re my labtop/mouse, [/SIZE][/SIZE][/SIZE][SIZE=16px]both bought in 2009,[/SIZE][SIZE=13px][SIZE=12px][SIZE=16px] too old?[/SIZE][/SIZE][/SIZE]


    [SIZE=13px][SIZE=12px][SIZE=16px]2. As you have seen, “Tipo sistema(System type) says I have Windows 10 32bit based on a 64bit processor; can it be a problem?[/SIZE][/SIZE][/SIZE]


    [SIZE=12px][SIZE=16px]3. Consider also that many times i had to shut the laptop down abruptly and remove the battery because Windows and/or Excel had stalled for several minutes. This might have left the laptop with ‘dirty’ stuff which hasn’t caused problems until now? If this is possible, should I buy a new ‘clean’ 64bit laptop with all 64bit software and hardware or keep the laptop I have and upgrade Windows 10 to 64bit and reinstal Excel?[/SIZE][/SIZE]


    [SIZE=13px][SIZE=12px][SIZE=16px]Thank you very much Tom for you time. By the way, please give me your paypal account or credit card number to send you the 45 bucks you earned.
    Have a nice Sunday.[/SIZE]    [/SIZE]    [/SIZE]


    [SIZE=13px][SIZE=12px][SIZE=16px]Guido[/SIZE][/SIZE][/SIZE]

    Hi Guido.


    Well I tested it in Excel 2010 and found it was not working :o(


    I added the following debug code...


    Private Sub cmdMouseWheel_Click()


    If blnMouseWheelActive = False Then
    cmdMouseWheel.Caption = "Mouse Wheel Deactivate"
    blnMouseWheelActive = True
    hwnd_XLApp = Application.hWnd
    hwnd_XLDesk = FindWindowEx(hwnd_XLApp, 0&, "XLDESK", vbNullString)
    hwnd_XLSheet = FindWindowEx(hwnd_XLDesk, 0&, "EXCEL7", ActiveWindow.Caption)


    Debug.Print ActiveWindow.Caption
    Debug.Print "hwnd_XLApp : " & hwnd_XLApp
    Debug.Print "hwnd_XLDesk : " & hwnd_XLDesk
    Debug.Print "hwnd_XLSheet : " & hwnd_XLSheet


    Which returned...


    excelcoding_mouse_wheel_scroll.xlsm
    hwnd_XLApp : 590440
    hwnd_XLDesk : 983866
    hwnd_XLSheet : 0


    So the windows handle for the worksheet necessary to hook into the WindowProc Callback function wasn't being found.


    When I looked at the actual Excel Window Caption..


    [ATTACH=JSON]{"data-align":"none","data-size":"full","title":"Untitled.jpg","data-attachmentid":1205016}[/ATTACH]


    The file extension.xlsm was not displayed...


    Went to Folder Options and unchecked Hide extensions for known file types...


    [ATTACH=JSON]{"data-align":"none","data-size":"full","title":"Untitled.jpg","data-attachmentid":1205017}[/ATTACH]


    Following which the windows handle for the worksheet was the found and everything was working as expected.


    excelcoding_mouse_wheel_scroll.xlsm
    hwnd_XLApp : 590932
    hwnd_XLDesk : 590496
    hwnd_XLSheet : 328436


    I suspect that you probably have this setting checked which I would not recommend for security reasons especially when opening Email attachments which are executable's and so may be a virus. So with this setting checked you can see that the file is an .exe which you should never click on.


    Note : Change the setting before opening the file in Excel otherwise it will use the old setting.


    Regarding payment of $45 as I am not yet an official Ozgrid Developer so as not to break the sites rules I don't think I am allowed to accept any payment. I was just browsing the forums and saw your post and felt it was something I could help out with. So suggest you donate the money to a Cancer Charity which should be acceptable to the Mods. I am actually hoping to become a Freelance Developer and currently working on content for my website excelcoding.com which will feature some of my Excel VBA work and I hope to have on line later this year.


    Regards,


    Tom Rowe

    Hi Tom,
    It works! Thank you! There's a strange behaviour:
    - the first time I open excelcoding_mouse_wheel_scroll.xlsm and scroll the page all is fine.
    - I close the file but it reopens automatically telling me:
    - Restore documents - Excel has restored the following files. Save the files you want. excelcoding.....scroll.xlsm is shown.
    - I close it again but, no matter if I save it or not, everytime I reopen it the same thing is shown.
    - I attached the screenshot which shows it (in Italian) because I can't find a way to put it in after the text. :oops:
    Do you know why this happens?
    Thank you
    Guido


    P.S. I made a donation to the American Cancer Society. Paypal Transaction ID is:

    [SIZE=12px]O-1B929149UR459291B[/SIZE]

    [TABLE="border: 0, cellpadding: 0, cellspacing: 0, width: 0"]

    [tr]


    [TD="align: right"] [/TD]
    [TD="width: 20, align: center"] [/TD]

    [/tr]


    [/TABLE]

    Hi Guido,


    I only noticed this behaviour if you went into the VBA Editor without deactivating the Mouse Wheel event Excel would crash and then restore automatically with the file.


    I notice from your screen shot that the command button was Mouse Wheel Deactivate so guess you did not deactivate it before shutting down Excel ? I would recommend that you do this which will hopefully prevent the file from restoring. Finally I would add that the CallWindowProc API is probably not one of the most reliable ones to use in VBA as basically you have virtually every single Windows Message coming into it so it's doing a lot of work which is why you should always deactivate itto prevent problems when you have finished using it.


    BTW thanks for making the donation to the American Cancer Society I am sure it will be appreciated and a very good cause.


    Regards,


    Tom...

Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!

Register Yourself Login