Dynamically highlight the cell under the Mouse Pointer !
The flickering is due to the delay caused by time it takes to run the code,
especially in comparison to a short timer interval. I thought of a couple
things to optimize the code somewhat in TimerProc (You can eliminate the
With... End With, since you only use ActiveWindow once inside this loop; you
can calculate .RangeFromPoint only once and assign that to another variable,
you can eliminate the DoEvents here since you end the Sub right after it, and
you can increase the timer interval a bit - one millisecond is much faster
than the user can respond) - but while these could make a bit of improvement
in the flickering nothing made it go away - and it seems that it is when the
mouse moves to a new cell while the code is running, that is when the
formatting gets messed up since the active cell changes before you can reset
the format. In the end, after testing it and seeing where the delay is
coming from, I believe it is caused by the call to GetCursorPos; and since
that is a library routine there is nothing you can do to change that.
Without the cursor position you can't highlight the cell, though, and I know
of no easier or quicker way to find it than what you are doing here. So
maybe I have helped define the problem a bit more, but afraid I can't offer a
solution!
"RAFAAJ2000" wrote:
The code I am using here does highlight the cell under the cursor ( Without
selecting the cell) but has two major problems :
1- It causes too much flickering .
2- If a cell is selected with the Mouse, the selected cell is sometimes
Formatted which shouldn't normally happen .
Here is the code:
Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent
As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent
As Long) As Long
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Type POINTAPI
x As Long
y As Long
End Type
Dim lngCurPos As POINTAPI
Dim TimerOn As Boolean
Dim TimerId As Long
Dim oldColor As Long
Dim R As Range
Sub StartTimer()
If Not TimerOn Then
TimerId = SetTimer(0, 0, 1, AddressOf TimerProc)
TimerOn = True
Else
MsgBox "Timer already On !", vbInformation
End If
End Sub
Sub TimerProc()
On Error Resume Next
With ActiveWindow
If Not R Is .RangeFromPoint(lngCurPos.x, lngCurPos.y) Then
R.Interior.ColorIndex = oldColor
End If
GetCursorPos lngCurPos
Set R = .RangeFromPoint(lngCurPos.x, lngCurPos.y)
oldColor = R.Interior.ColorIndex
.RangeFromPoint(lngCurPos.x, lngCurPos.y).Interior.ColorIndex = 3 'Red
End With
DoEvents
End Sub
Public Sub StopTimer()
If TimerOn Then
KillTimer 0, TimerId
TimerOn = False
Else
MsgBox "Timer already Off", vbInformation
End If
End Sub
I hope someone can improve this code by fixing the 2 mentioned problems or
maybe just offer a new solution altogether.
Thanks.
Jaafar.
|