Hi,
There is no mouse over event in Excel but you can do it with this code in a
standard module. To activate it run the sub 'Hook mouse'. To deactivate it
run the sub
'unhook mouse'. Change the range in the hook mouse sub to whatever you want.
I can't remember where I copied this code from and the source isn't credited
in the comments so apologies and thanks to the original author.
Option Explicit
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 CallNextHookEx Lib "user32" _
(ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As
Any) As Long
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As
Long
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
x As Long
Y As Long
End Type
Const HC_ACTION = 0
Const WH_MOUSE_LL = 14
Const WM_MOUSEMOVE = &H200
Dim hhkLowLevelMouse As Long
Dim blnHookEnabled As Boolean
Dim udtCursorPos As POINTAPI
Dim objCell As Variant
Dim objTargetRange As Range
Public Function LowLevelMouseProc _
(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'\\ Prevent error if objCell is Nothing
On Error Resume Next
If (nCode = HC_ACTION) Then
'\\ when Mouse is moved
If wParam = WM_MOUSEMOVE Then
'\\ Process WM_MOUSEMOVE message first
LowLevelMouseProc = False
'\\ Get Mouse Pointer location in Screen Pixels
GetCursorPos udtCursorPos
'\\ Get Cell under Cursor
Set objCell = ActiveWindow.RangeFromPoint(udtCursorPos.x,
udtCursorPos.Y)
'\\ If Cursor not over a Range or outside TargetRange restore
Default Cursor
If objCell Is Nothing Or _
(Union(objCell, objTargetRange).Address <>
objTargetRange.Address) Then
Application.Cursor = xlDefault
Else
Application.Cursor = xlIBeam
End If
End If
Exit Function
End If
' \\ Call next hook if any
LowLevelMouseProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
End Function
Sub Hook_Mouse()
'\\ Prevent Hooking more than once
If blnHookEnabled = False Then
'\\ Change this Target range address as required
Set objTargetRange = Sheets("Sheet1").Range("A1:A20")
hhkLowLevelMouse = SetWindowsHookEx _
(WH_MOUSE_LL, AddressOf LowLevelMouseProc, Application.Hinstance, 0)
blnHookEnabled = True
End If
End Sub
Sub UnHook_Mouse()
If hhkLowLevelMouse <> 0 Then UnhookWindowsHookEx hhkLowLevelMouse
'\\ reset Flag
blnHookEnabled = False
End Sub
