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.
|