View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
RAFAAJ2000[_2_] RAFAAJ2000[_2_] is offline
external usenet poster
 
Posts: 75
Default Subclassing in Excel ! ...So frustrating !

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.