Sublassing stops mouse-clicks

Can you post the code that you are using?  What version of Windows are you using?

'in an Excel code module
Option Explicit
 
Public Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, _
ByVal nCode As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
 
Public Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
 
Public 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
 
Declare Function GetCurrentThreadId Lib "kernel32" _
() As Long
 
Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long
 
Public Const WH_MOUSE = 7
Public Const HC_ACTION = 0
Public Const WM_MOUSEMOVE = &H200
 
Public Type POINTAPI
    X As Long
    Y As Long
End Type
 
Public hHook As Long
 
Private Function MouseProc(ByVal nCode As Long, ByVal wParam As Long, _
    ByVal lParam As Long) As Long
    If nCode >= 0 Then
        If nCode = HC_ACTION And wParam = WM_MOUSEMOVE Then
            TrackMouse
        Else: If Not Application.StatusBar = False Then Application.StatusBar = False
        End If
    End If
    MouseProc = CallNextHookEx(hHook, nCode, wParam, lParam)
     
End Function
 
Private Sub TrackMouse()
    Dim pt As POINTAPI
     
    GetCursorPos pt
    Application.StatusBar = "moved" 'Application.ActiveWindow.RangeFromPoint(pt.X, pt.Y).Address
    Debug.Print "Moved"
     
End Sub
 
Public Sub Initialize_Hook()
    hHook = SetWindowsHookEx(WH_MOUSE, AddressOf MouseProc, 0&, GetCurrentThreadId)
    ResetHook
End Sub
 
Public Sub Terminate_Hook()
    Call UnhookWindowsHookEx(hHook)
End Sub
 
Public Sub ResetHook()
    Call UnhookWindowsHookEx(hHook)
    hHook = SetWindowsHookEx(WH_MOUSE, _
    AddressOf MouseProc, 0&, GetCurrentThreadId)
End Sub


'in the class module of the active sheet - kicks the hook off when you move between cells

Private blnHooked As Boolean
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
     
    If Not blnHooked Then
        Initialize_Hook
    Else
        Terminate_Hook
    End If
     
    blnHooked = Not blnHooked
     
End Sub

Why are you toggling the hooking on and off in the selectionchange event?  Exactly what behavior are you trying to get?  Is the only problem that the click event is not firing or is there something else?

Thats just a convenient way to set the hook off. But if you try it, you'll see that mouse-clicks are no longer received by the client window.

As the other threads states, the idea is to achieve a mouse_move event for the Excel spreadsheet and determine the position of the cursor over the sheet - something that isn't otherwise possible.

But why start hooking, then terminate hooking, then start hooking again, then terminate again.......  every time you move between cells???  What does this gain for you?  Why not start hooking on the worksheet_activate event and stop in the worksheet_deactivate event?

Prestaul, please run the code and read the full story in the other thread. I'm afraid you've missed the point.

I have run the code and I have read and subscribed to the other thread.  I am the only person participating in this thread at the moment and I have much experience with subclassing in VB (though not in VBA) and I believe that my questions are relevant:

<Why not start hooking on the worksheet_activate event and stop in the worksheet_deactivate event?>

This will not make your code work, but if it represents another flaw that you've overlooked then you have to fix it.

<But why start hooking, then terminate hooking, then start hooking again, then terminate again.......  every time you move between cells???>

Remove the initialize/terminate hook lines in the selectionchange event and replace them with msgbox "initialize" and msgbox "terminate".  You open the sheet and nothing happens.  You move one cell: initialize.  You move again: terminate...  no more hooking.  You move one more cell: initialize...  you are hooking again.  Is this the behavior that you want?  If so then explain why so that I can understand and maybe help you.

Also I asked in my very first post which version of Windows you are using.  Please answer this question as well.  If you don't understand why I might ask this question then you should take a step back and find a book or a tutorial on subclassing or APIs in general before finishing this project.

I am trying to help you kill a bug.  I don't have access to your machine, I can't read your mind.  Please answer my questions or wait for someone else to help you.

If you want to do some more looking on your own then download the ISubclass.cls and MSubclass.bas files from VBAccellerator.com.  They add a layer of abstraction to the subclassing calls and greatly simplify the work.  You won't be able to use a worksheet to implement ISubclass so you'll have to add one more class module to get it to work.

You aren't going to be able to capture messages for an individual sheet.  You will, in essence, be hooking for your entire Excel application.  There is no way around this.  A sheet doesn't execute in it's own thread and doesn't have  it's own window (and therefore it's own hWnd).

Prestaul I apologise if my tone offended you, it wasn't my intention. By way of explaination - when I run the code, once the hook is in place, I can no longer select any cells on the sheet, thus the toggle effect never occurs, making it a non-issue (to me).

If you do not experience this when you tried the code, then there is possibly something wrong with my machine (Windows XP), though it seems strange since I encounter the same difficulty with my PC at work - multi-national bank with good IT ethic (also XP - and I do understand the relevancy;) ).

We could use any method to kick off the hook - or not use a hook at all. My other project variation on the site I linked to (in the other thread) used a commandbutton on a form to initalise a subclass of the EXCEL7 window (which IS the spreadsheet window as opposed to the XLMAIN Application window) - but I observed the same effect. The mouse input was disabled until the subclass is removed.
Here's a group I participate with where the Excel window structure is explored to some detail
http://www.markrowlinson.co.uk/apiwbopen.php

No offense taken, I just want to make sure that I have all of the information.  The code that you pointed to (markrowlinson.co.uk) was very interesting, but you should take a look again and not that you are still gaining a handle to an entire instance of Excel and not just one sheet.  It is specific to one WORKBOOK but not one WORKSHEET.  This means that there is no discrimination between your mouse being over a cell in the sheet or over a menu item and the x/y coordinates returned when this does work will be from the top left corner of the window, not the sheet.  This could make processing a little bit more difficult as different users will display different toolbars and who knows what else above the sheet itself.  I think that I remember seeing some code on xl-logic.com that will convert mouse coordinates to a range, but it's been a while and I'm not certain that was the exact behavior.  When we get there I can look again.

With the code you have above and a little tweaking (moving initialize to the activate event, etc.) I was able to get the mouseproc procedure to fire and put the mouse coordinates into the first two cells in the sheet.  Excel would also allow me to click and drag to select cells but immediately after the first range was selected it threw an error on me and closed...  Were you able to see any behavior like this?

Are you trying to write a generic mousemove event for Excel spreadsheets, or are you trying to achieve something specific?  If something specific then maybe we can find an easier way than subclassing.

It's a generic mousemove I'm after, and you've managed more than I have so far if you were able to interact with the sheet once the hook was in place! The other approach would be to use SetTimer to test the mouse position, but that is a clunky approach when one such as this is so close to becoming!

I don't have problems getting the messages sent, the debug.print shows me that. But once the hook or subclass is in place, I can no longer interact with the sheet. When sublassing (but not the hook), I can still enter the Excel formula bar above the sheeet using the mouse, hit enter, then scroll abround the sheet using the cursor keys. But any clicks from the mouse are simply ignored.

Since the hook monitors the application thread, I'm not surprised that the whole application is frozen whereas the subclass approach only affects the spreadsheet window. The project I posted on the other site demonstrates this.

On the worksheet window, I've been of the understanding that the EXCLE7 window is the spreadsheet area only. This idea has been reinforced by viewing the window heirarchy within the XLMAIN window
http://www.markrowlinson.co.uk/apiallwindows.php
however, as you say, that's the next bridge!

I have a sheet that puts the hook in place and allows me to interact with the sheet.  Now there are some other issues with errors and Excel shutting down that I haven't looking into yet, but this might help anyway.  I was just trying some random things and this works.  The things that seemed to make the difference was using something like RefreshHook every time the new window procedure is called.  I started with your Display_MousePos.xls file and modified it as below:

1) Removed userform1

2) Workbook module:

Option Explicit

Private Sub Workbook_Activate()
    MousePosition_Detect
End Sub

Private Sub Workbook_Deactivate()
    MousePosition_EndDetect
End Sub

Private Sub Workbook_Open()
Const DISCLAIMER As String = "DISCLAIMER: " & vbCrLf & vbLf & _
            "Caution! This project makes extensive use of windows subclassing methods. " & vbLf & _
            "If you're not sure what that means, then don't use it." & vbLf & vbLf & _
            "If you do use this project, the risk is all yours." & vbLf & vbLf & _
            "Hit 'OK' to get on with it, or 'Cancel' to scarper."

    If MsgBox(DISCLAIMER, vbCritical + vbDefaultButton2 + vbOKCancel, "Terms of use") = vbCancel Then
        ThisWorkbook.Close False
        Exit Sub
    End If
End Sub



3) Module1:

Option Explicit
                       
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
    (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
    (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long

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

'hook type definition
Private Const GWL_WNDPROC = (-4)
'mouse move message
Private Const WM_NCHITTEST As Long = &H84

'pointer to the native WindowProc
Private PrevProc As Long
Private hWnd As Long
Private hWnd_App As Long
Private OldlParam As Long

'sub launched by UserForm_Initialize
Public Sub MousePosition_Detect()
    'return application window handle
    hWnd_App = FindWindow("XLMAIN", vbNullString)
    'find it's child, the Workbooks window
    hWnd = FindWindowEx(hWnd_App, 0&, "XLDESK", vbNullString)
    'find it's child, the Workbook window
    hWnd = FindWindowEx(hWnd, 0&, "EXCEL7", vbNullString)
   
    Window_Hook
End Sub

'sub called by UserForm_QueryClose
Public Sub MousePosition_EndDetect()
    Window_UnHook
End Sub

'start the subclass
Private Sub Window_Hook()
    'substitute the system WindowProc with ours and return the pointer
    '   to the original WindowProc
    PrevProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf Window_Events)
End Sub

'halt the subclass
Private Sub Window_UnHook()
    'replace the original WindowProc pointer
    SetWindowLong hWnd, GWL_WNDPROC, PrevProc
End Sub


Private Function Window_Events(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    On Error GoTo End_Window_Events
   
    Select Case uMsg
        'the Mouse_Move message
        Case WM_NCHITTEST
            'show the mouse postion
            If OldlParam <> lParam Then
                ShowPosition LoWord(lParam), HiWord(lParam)
                OldlParam = lParam
            End If
        Case Else
            'Do nothing
    End Select

    'pass the message to the original procedure
    Window_Events = CallWindowProc(PrevProc, hWnd, uMsg, wParam, lParam)
   
End_Window_Events:
End Function

'return Y Mouse coordinates
Private Function HiWord(dw As Long) As Integer

    If dw And &H80000000 Then
       HiWord = (dw \ 65535) - 1
    Else
       HiWord = dw \ 65535
    End If
   
End Function
 
'return X Mouse coordinates
Private Function LoWord(dw As Long) As Integer

    If dw And &H8000& Then
       LoWord = &H8000& Or (dw And &H7FFF&)
    Else
      LoWord = dw And &HFFFF&
    End If
   
End Function

'actions in response to a move event
Private Sub ShowPosition(ByVal X As Long, ByVal Y As Long)
Dim strCellNext As String
Static blnProcessing As Boolean
Static strCellLast As String

    On Error GoTo End_ShowPosition
   
    'prevent recursion
    If blnProcessing Then Exit Sub
    blnProcessing = True

    'return the address of the cursor cell
    strCellNext = Application.Windows(1).RangeFromPoint(X, Y).Address(External:=True)
   
    'only update the form if the mouse has moved over another cell
    If Not strCellLast = strCellNext Then
        ThisWorkbook.Sheets("Sheet1").Cells(1, 1) = strCellNext
        strCellLast = strCellNext
    End If
   
End_ShowPosition:
    Window_UnHook
    DoEvents
    Window_Hook
    blnProcessing = False
End Sub


I hope that this helps a bit.  There are certainly some more bugs to work out of it.  I don't like the hit test message that we're using in this code because it seems to fire constantly (whether the mouse moves or not), but I can't get the Mouse Move message to fire unless I also trap the hit test message...  Any ideas why that might be?  Icky...

Good work! Refreshing the subclass definitely seems to overcome the screen updating issue, you can now scroll the sheet using the cursor keys without having to first enter the formula bar. However, I still cannot select cells/ranges with the mouse - this action freezes the window once again, although CTRL+BREAK allows you to get past that.

Previously (early on!) I tried the 'TrackMouseEvent' function:
http://www.xtremevbtalk.com/showthread.php?t=172879

I've learned a one or two things since then, but in keeping with the other techniques we've tried, it seems that attempts to capture the mouse explicitly remain elusive. I have no clue why that is. The nearest thing I've found so far is the MSKB article I linked to in the other thread on the Windows Programming board.

The code works fine until I use the mouse in any way, then everything just freezes until I give it the CTRL+BREAK treatment. Are you using XP as well? Both my machines are XP. I know SP2 prevented this routine from running at all on my other machine, prompting me to un-install it immediately.

UPDATE: It just occured to me to move the subclass refresh up into the end of the WIndowProc. It works! At last the mouse does not freeze the window - hoorah!!

But, as soon as I started some more adventurous mouse manouvers, I did get the GPF. I'm thinking that if I can determine the WM_LEAVE message, we can terminate the subclass before that happens... Nearly there! This is the largest advance on this project in literally months.

Thanks you for sticking it out. Most Windows/VB developers are too suspicious of Office products and refuse to get their hands dirty. I take my hat off to you sir :)

If you post in the other thread, I'll drop you the points there too as promised. Naturally I'd love to see the GPF issue resolved but I'm hopefull that solution will be more forth-coming.

A few adjustments and now no GPF. This epic seems to be at an end! Thanks again Prestaul :)

Just for the record, if you run a Google search for this technique, you will come up with zilch. I predict it will be rife in a few months with everyone claiming responsibility. This has been in the making for 4 months, and effectively solo to this point - you saw it here first ;)


'Worksheet Module

Option Explicit

Private Sub Worksheet_Activate()
    If Not blnSubclass Then MousePosition_Detect
End Sub

Private Sub Worksheet_Deactivate()
    If blnSubclass Then MousePosition_EndDetect
End Sub


'Module
Option Explicit
                       
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
    (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
    (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long

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

'hook type definition
Private Const GWL_WNDPROC = (-4)
'mouse move message
Private Const WM_NCHITTEST As Long = &H84

'global flag to indicate the subclass is running
Public blnSubclass As Boolean

'pointer to the native WindowProc
Private PrevProc As Long
Private hWnd As Long
Private hWnd_App As Long
Private OldlParam As Long

'sub launched by UserForm_Initialize
Public Sub MousePosition_Detect()
    'return application window handle
    hWnd_App = FindWindow("XLMAIN", vbNullString)
    'find it's child, the Workbooks window
    hWnd = FindWindowEx(hWnd_App, 0&, "XLDESK", vbNullString)
    'find it's child, the Workbook window
    hWnd = FindWindowEx(hWnd, 0&, "EXCEL7", vbNullString)
   
    Window_Hook
End Sub

'sub called by UserForm_QueryClose
Public Sub MousePosition_EndDetect()
    Window_UnHook
    Application.StatusBar = False
End Sub

'start the subclass
Private Sub Window_Hook()
    'substitute the system WindowProc with ours and return the pointer
    '   to the original WindowProc
    PrevProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf Window_Events)
    blnSubclass = True
End Sub

'halt the subclass
Private Sub Window_UnHook()
    'replace the original WindowProc pointer
    SetWindowLong hWnd, GWL_WNDPROC, PrevProc
    blnSubclass = False
End Sub


Private Function Window_Events(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error GoTo Error_H
   
    Select Case uMsg
        'the Mouse_Move message
        Case WM_NCHITTEST
            'show the mouse postion
            If OldlParam <> lParam Then
                ShowPosition LoWord(lParam), HiWord(lParam)
                OldlParam = lParam
            End If
        Case Else
            'Do nothing
    End Select

    'pass the message to the original procedure
    Window_Events = CallWindowProc(PrevProc, hWnd, uMsg, wParam, lParam)
   
Finish:
   
    Window_UnHook
    DoEvents
    Window_Hook
    Exit Function

Error_H:
    Resume Finish
   
End Function

'return Y Mouse coordinates
Private Function HiWord(dw As Long) As Integer

    If dw And &H80000000 Then
       HiWord = (dw \ 65535) - 1
    Else
       HiWord = dw \ 65535
    End If
   
End Function
 
'return X Mouse coordinates
Private Function LoWord(dw As Long) As Integer

    If dw And &H8000& Then
       LoWord = &H8000& Or (dw And &H7FFF&)
    Else
      LoWord = dw And &HFFFF&
    End If
   
End Function

'actions in response to a move event
Private Sub ShowPosition(ByVal X As Long, ByVal Y As Long)
Dim strCellNext As String
Static blnProcessing As Boolean
Static strCellLast As String

On Error GoTo Error_H
   
    'prevent recursion
    If blnProcessing Then Exit Sub
    blnProcessing = True

    If ActiveWindow.RangeFromPoint(X, Y) Is Nothing Then GoTo Finish
   
    'return the address of the cursor cell
    strCellNext = ActiveWindow.RangeFromPoint(X, Y).Address(External:=True)
   
    'only update the form if the mouse has moved over another cell
    If Not strCellLast = strCellNext Then
        Application.StatusBar = strCellNext
        strCellLast = strCellNext
    End If
   
Finish:
    blnProcessing = False
    Exit Sub
   
Error_H:
    Resume Finish
   
End Sub

Congratulations, Colonel.  I'm glad that I was able to help in some limited way.  This is a great bit of code and I'm sure that there are many developers out there (including myself) who have wished for a mousemove event in Excel at one point or another but have lacked the time, or skills to put something together.