Hi all,

I have tried writing subclassing code in Excel time and time again but not
once have I been successful. Either the code just doesn't work or even worse,
it crashes the application.

I have followed every single step described in many VB codes that I have
seen on the Web and on many VB books and have tried applying them to
Excel\VBA but no luck !.

As a simple example, I wanted to trap the Mouse Move event by subcclassing
the Excel application Window so that a Msgbox pops up whenever the user
hovers the mouse over a given worksheet range . Even this basic subclassing
code causes the application to freeze or crash !!! Unbelievable !!!

I have seen many good Excel books showing nice API code examples but they
ALL seem to shy away from \ avoid the subject of subclassing despite being an
extremely powerful technic !!

Does subcclassing not work for VBA\Excel ? Or is it just me who doesn't know
how to implement it ?? I still don't have a clear answer .

Any thoughts would much appreciated .

Regards.

It works. Show the code.

--

HTH

RP
(remove nothere from the email address if mailing direct)


"RAFAAJ2000" wrote in message
...
Hi all,

I have tried writing subclassing code in Excel time and time again but
not
once have I been successful. Either the code just doesn't work or even
worse,
it crashes the application.

I have followed every single step described in many VB codes that I have
seen on the Web and on many VB books and have tried applying them to
Excel\VBA but no luck !.

As a simple example, I wanted to trap the Mouse Move event by subcclassing
the Excel application Window so that a Msgbox pops up whenever the user
hovers the mouse over a given worksheet range . Even this basic
subclassing
code causes the application to freeze or crash !!! Unbelievable !!!

I have seen many good Excel books showing nice API code examples but they
ALL seem to shy away from \ avoid the subject of subclassing despite being
an
extremely powerful technic !!

Does subcclassing not work for VBA\Excel ? Or is it just me who doesn't
know
how to implement it ?? I still don't have a clear answer .

Any thoughts would much appreciated .

Regards.

Hi Bob,

Thanks for your quick reply.

Here is a simple example that is supposed to display a standard Msgbox
whenever the user hovers the mouse over cell A1.

The code seems correct to me but it just doesn't work. In fact it crashes
the whole application !

Code goes into a Standard module:


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


Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

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

Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Type POINTAPI
x As Long
y As Long
End Type

Const GWL_WNDPROC As Long = (-4)
Const WM_MOUSEMOVE = &H200

Dim OldWindowProc As Long
Dim hwnd As Long
Dim lngCurPos As POINTAPI
Dim R As Range

Sub SubClass()

'Subclass The ONLY loaded workbook Window
hwnd = Application.hwnd
hwnd = FindWindowEx(hwnd, 0, "XLDESK", vbNullString)
hwnd = FindWindowEx(hwnd, 0, "EXCEL7", vbNullString)

OldWindowProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf NewWindowProc)

End Sub

Function NewWindowProc(ByVal hwnd As Long, ByVal Msg _
As Long, ByVal wParam As Long, ByVal lParam As Long) As _
Long

Set R = ActiveWindow.RangeFromPoint(lngCurPos.x, lngCurPos.y)

If Msg = WM_MOUSEMOVE And R.Address = Range("a1").Address Then
MsgBox "The Mouse is over cell 'A1'", vbInformation
End If
' Pass Intercepted Messages To The Original WinProc
NewWindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wParam,
lParam)
End Function


Sub UnSubclass()
'UnSubclass The WB window
SetWindowLong hwnd, GWL_WNDPROC, OldWindowProc
End Sub


Caution!! : Before running this code make sure you have saved all your
work as it will crash the Excel application!!!!!!


Unless I am missing something obvious, If anyone out there in the Excel
community can make this simple subclassing example work , I will be amazed !!


Jaafar.
Regards.





"Bob Phillips" wrote:

It works. Show the code.

Oops !

Sorry , I forgot to add an " On Error Resume Next " at the beginning of the
NewWindowProc procedure .

This is to ensure that no error is generated on the code line : " Set R =
ActiveWindow.RangeFromPoint(lngCurPos.x, lngCurPos.y)" if the mouse happens
to be outside the worksheet cells space.

Regards.

I don't know if things have improved with recent versions of Excel, but I
seem to recall that subclassing the Excel window used to cause GPFs in the
old days, especially with Mouse_Move events. Maybe nothing has changed
except that we don't call them GPFs any longer :).

--

Vasant

"RAFAAJ2000" wrote in message
...
Oops !

Sorry , I forgot to add an " On Error Resume Next " at the beginning of
the
NewWindowProc procedure .

This is to ensure that no error is generated on the code line : " Set R =
ActiveWindow.RangeFromPoint(lngCurPos.x, lngCurPos.y)" if the mouse
happens
to be outside the worksheet cells space.

Regards.

vba is just too slow to catch all messages to a workbook window and
pass them along, even if you dont do anything inside the procedure

since you'll have taskmanager open anyway :)
watch the CPU usage graph...

subclassing works ok on userforms, for worksheets it's NOT a viable
solution.

however to give you a taste...

the subclassed proc doesnt catch the wm_mousemove
(maybe it comes too close to the message before it and it is dropped

so i've used wm_nchittest, but you'll get a LOT of them...
code below works some of the time. subclassing stops at n=999 to
prevent runaway code...you'll need it :(



Option Explicit

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

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long)
As Long

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

Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Type POINTAPI
x As Long
y As Long
End Type

Const GWL_WNDPROC As Long = (-4)
Const WM_MOUSEMOVE = &H200
Const WM_NCHITTEST As Long = &H84
Const WM_DESTROY As Long = &H2


Dim OldWindowProc As Long

Dim lpWnd As Long
Dim n As Long
Dim pa As POINTAPI
Dim rg As Range
Dim rgHit As Range



Sub SubClass()
'Subclass The ONLY loaded workbook Window
lpWnd = FindWindowEx(Application.hwnd, 0, "XLDESK", vbNullString)
lpWnd = FindWindowEx(lpWnd, 0, "EXCEL7", ActiveWindow.Caption)
Set rgHit = ActiveSheet.Range("a1:a20")
n = 0
OldWindowProc = SetWindowLong(lpWnd, GWL_WNDPROC, AddressOf
NewWindowProc)

End Sub

Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal
wParam As Long, ByVal lParam As Long) As Long

Dim lRet&
n = n + 1
If hwnd = lpWnd Then
Select Case Msg
Case WM_NCHITTEST
lRet = GetCursorPos(pa)
On Error Resume Next
Set rg = ActiveWindow.RangeFromPoint(pa.x, pa.y)
On Error GoTo 0
If Not rg Is Nothing Then
If Not Intersect(rg, rgHit) Is Nothing Then
MsgBox ("Gotcha")
n = 0
End If
End If
Case WM_DESTROY
UnSubclass
End Select
End If

' Pass Intercepted Messages To The Original WinProc
NewWindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wParam,
lParam)

If n 999 Then
UnSubclass
End If

End Function


Sub UnSubclass()
'UnSubclass The WB window

SetWindowLong lpWnd, GWL_WNDPROC, OldWindowProc
MsgBox "pffff..i dont like working so hard"
End Sub




--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


RAFAAJ2000 wrote :

Oops !

Sorry , I forgot to add an " On Error Resume Next " at the beginning
of the NewWindowProc procedure .

This is to ensure that no error is generated on the code line : "
Set R = ActiveWindow.RangeFromPoint(lngCurPos.x, lngCurPos.y)" if the
mouse happens to be outside the worksheet cells space.

Regards.

KeepITCool, .....That's nice and quite close to what I was looking
for.However, the window freezes while the window is subclassed and you can't
select a cell or edit the worksheet until the window is unsubclassed !

How about checking for a different message instead of WM_NCHITTEST which
seems to be sent too frequently ?

Another thing that I have noticed is this :

Suppose that you subclass an XL window as we did only this time we don't
write any code in the NewWindowProc callback procedure apart from the line :

NewWindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wParam, lParam)

in orger to pass all messages back to the original window procedure.

In theory , this would be as if the XL window wasn't subclassed as all
messages are left intact before passing them back. but in practice, what you
get is a nasty frozen XL window !! :(

Any idea why this is so or if that could be avoided ?

Regards.

Dim OldWindowProc As Long
Dim hwnd As Long
Dim lngCurPos As POINTAPI
Dim R As Range

Sub SubClass()

'Subclass The ONLY loaded workbook Window
hwnd = Application.hwnd
hwnd = FindWindowEx(hwnd, 0, "XLDESK", vbNullString)
hwnd = FindWindowEx(hwnd, 0, "EXCEL7", vbNullString)

OldWindowProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf
NewWindowProc)

End Sub

After the Sub named SubClass is run, doesn't the variable OldWindowProc (as
well as all of the other module-level variables) go out of scope? This would
mean that VBA would throw the value away (clear it?), meaning it will no
longer be available for later calls when the mouse moves over the window and
needs to use it again.
--
Regards,
Bill

Thanks Bill,

I am not sure I understand what you mean but none of the variables go out of
scope as they are all declared at a module level.

Any other ideas ?

Regards.


"Bill Renaud" wrote:

Dim OldWindowProc As Long
Dim hwnd As Long
Dim lngCurPos As POINTAPI
Dim R As Range

Sub SubClass()

'Subclass The ONLY loaded workbook Window
hwnd = Application.hwnd
hwnd = FindWindowEx(hwnd, 0, "XLDESK", vbNullString)
hwnd = FindWindowEx(hwnd, 0, "EXCEL7", vbNullString)

OldWindowProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf
NewWindowProc)

End Sub

After the Sub named SubClass is run, doesn't the variable OldWindowProc (as
well as all of the other module-level variables) go out of scope? This would
mean that VBA would throw the value away (clear it?), meaning it will no
longer be available for later calls when the mouse moves over the window and
needs to use it again.
--
Regards,
Bill

Maybe the Help topic "Understanding the Lifetime of Variables" will clarify
some of these points:
"A module-level variable differs from a static variable. In a standard
module or a class module, it retains its value until you stop running your
code."

(I haven't personally worked with callback procedures and DLL calls, etc.,
but just happened to see this topic while browsing and thought this might be
one idea that might lead to the source of the problem.)

For example, build the following trivial standard module and test the
following code:
==========
Option Explicit

Dim lngTest As Long 'Module-level variable

Public Sub Test()
lngTest = 1
End Sub
==========

Single-step through Sub Test with the Locals window open. Notice that the
value of lngTest is available (and valid) only while Sub Test is running.
Double-check this by entering the command "?lngTest" in the Immediate
window. Now after Sub Test is finished, enter the command "?lngTest" in the
Immediate window again. Notice that the value is now blank (VBA has cleared
it!).

Doesn't the same thing happen to the value of OldWindowProc in your Sub
SubClass as soon as it is finished running the first (and only) time?
Function NewWindowProc won't get called until the mouse moves, so therefore,
won't the value of OldWindowProc be out of scope from the time that Sub
SubClass ends and the time that the next mouse event occurs? What happens if
you insert a Debug.Print OldWindowProc in Function NewWindowProc and watch
it in the Immediate window while the code runs?
--
HTH,
Bill


"RAFAAJ2000" wrote in message
...
Thanks Bill,

I am not sure I understand what you mean but none of the variables go out
of
scope as they are all declared at a module level.

Any other ideas ?

Regards.

OK, the following demo does work the way you want (forget my previous post
30 minutes ago). The module-level variable is kept between Sub calls anyway
(now I'm confused :( ). I thought VBA cleared them when no code was running!
(Is this behavior a bug, or are the Help topics wrong? Can anybody trust
this behavior?)
---------------
Option Explicit

Dim lngTest As Long

Sub InitializeVariable()
lngTest = 123
End Sub

Sub UseVariable()
MsgBox "lngTest is: " & lngTest
End Sub
---------------

Simply run InitializeVariable, then run UseVariable.
--
Regards,
Bill

Jafaar,
How about a hack with a non subclassing way ?

A transparent, borderless image box, which will fire the MouseMove event. You get quite a flicker (which you may be able to do something about), but if the test area is small compared to the area of
the worksheet, you may be OK.

Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim MyRange As Object
Dim RetVal As Long

Image1.Visible = False

With Application
.ScreenUpdating = False
With .Windows(1)
RetVal = GetCursorPos(pa)

Set MyRange = .RangeFromPoint(pa.X, pa.Y)

MyRange.Value = "Done"
End With
.ScreenUpdating = True
End With

Image1.Visible = True

End Sub

NickHk


On Sun, 1 May 2005 13:11:08 -0700, "RAFAAJ2000" wrote:

Hi Bob,

Thanks for your quick reply.

Here is a simple example that is supposed to display a standard Msgbox
whenever the user hovers the mouse over cell A1.

The code seems correct to me but it just doesn't work. In fact it crashes
the whole application !

Code goes into a Standard module:


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


Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

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

Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Type POINTAPI
x As Long
y As Long
End Type

Const GWL_WNDPROC As Long = (-4)
Const WM_MOUSEMOVE = &H200

Dim OldWindowProc As Long
Dim hwnd As Long
Dim lngCurPos As POINTAPI
Dim R As Range

Sub SubClass()

'Subclass The ONLY loaded workbook Window
hwnd = Application.hwnd
hwnd = FindWindowEx(hwnd, 0, "XLDESK", vbNullString)
hwnd = FindWindowEx(hwnd, 0, "EXCEL7", vbNullString)

OldWindowProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf NewWindowProc)

End Sub

Function NewWindowProc(ByVal hwnd As Long, ByVal Msg _
As Long, ByVal wParam As Long, ByVal lParam As Long) As _
Long

Set R = ActiveWindow.RangeFromPoint(lngCurPos.x, lngCurPos.y)

If Msg = WM_MOUSEMOVE And R.Address = Range("a1").Address Then
MsgBox "The Mouse is over cell 'A1'", vbInformation
End If
' Pass Intercepted Messages To The Original WinProc
NewWindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wParam,
lParam)
End Function


Sub UnSubclass()
'UnSubclass The WB window
SetWindowLong hwnd, GWL_WNDPROC, OldWindowProc
End Sub


Caution!! : Before running this code make sure you have saved all your
work as it will crash the Excel application!!!!!!


Unless I am missing something obvious, If anyone out there in the Excel
community can make this simple subclassing example work , I will be amazed !!


Jaafar.
Regards.





"Bob Phillips" wrote:

It works. Show the code.

Nice hack NickHK,

I 've actually used this trick before and to get rid of the flickering I
just don't use the ScreenUpdating property anywhere in the code.

My real purpose for asking this question was to see some Subclassing code in
Excel which is not easy to find.

Thanks again.

Jaafar.



"NickHK" wrote:

Jafaar,
How about a hack with a non subclassing way ?

A transparent, borderless image box, which will fire the MouseMove event. You get quite a flicker (which you may be able to do something about), but if the test area is small compared to the area of
the worksheet, you may be OK.

Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim MyRange As Object
Dim RetVal As Long

Image1.Visible = False

With Application
.ScreenUpdating = False
With .Windows(1)
RetVal = GetCursorPos(pa)

Set MyRange = .RangeFromPoint(pa.X, pa.Y)

MyRange.Value = "Done"
End With
.ScreenUpdating = True
End With

Image1.Visible = True

End Sub

NickHk


On Sun, 1 May 2005 13:11:08 -0700, "RAFAAJ2000" wrote:

Hi Bob,

Thanks for your quick reply.

Here is a simple example that is supposed to display a standard Msgbox
whenever the user hovers the mouse over cell A1.

The code seems correct to me but it just doesn't work. In fact it crashes
the whole application !

Code goes into a Standard module:


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


Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

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

Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Type POINTAPI
x As Long
y As Long
End Type

Const GWL_WNDPROC As Long = (-4)
Const WM_MOUSEMOVE = &H200

Dim OldWindowProc As Long
Dim hwnd As Long
Dim lngCurPos As POINTAPI
Dim R As Range

Sub SubClass()

'Subclass The ONLY loaded workbook Window
hwnd = Application.hwnd
hwnd = FindWindowEx(hwnd, 0, "XLDESK", vbNullString)
hwnd = FindWindowEx(hwnd, 0, "EXCEL7", vbNullString)

OldWindowProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf NewWindowProc)

End Sub

Function NewWindowProc(ByVal hwnd As Long, ByVal Msg _
As Long, ByVal wParam As Long, ByVal lParam As Long) As _
Long

Set R = ActiveWindow.RangeFromPoint(lngCurPos.x, lngCurPos.y)

If Msg = WM_MOUSEMOVE And R.Address = Range("a1").Address Then
MsgBox "The Mouse is over cell 'A1'", vbInformation
End If
' Pass Intercepted Messages To The Original WinProc
NewWindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wParam,
lParam)
End Function


Sub UnSubclass()
'UnSubclass The WB window
SetWindowLong hwnd, GWL_WNDPROC, OldWindowProc
End Sub


Caution!! : Before running this code make sure you have saved all your
work as it will crash the Excel application!!!!!!


Unless I am missing something obvious, If anyone out there in the Excel
community can make this simple subclassing example work , I will be amazed !!


Jaafar.
Regards.





"Bob Phillips" wrote:

It works. Show the code.