Option Explicit
Public Declare PtrSafe Function GetCursorPos Lib "user32" ( _
lpPoint As POINTAPI) As Long
Public Declare PtrSafe Function SetTimer Lib "user32" ( _
ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, _
ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Public Declare PtrSafe Function KillTimer Lib "user32" ( _
ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public iTimerID As LongPtr
Public hWnd As LongPtr
Sub CheckMouseOverRange()
Dim R As RECT, Pt As POINTAPI, AC As Object
Dim iCur As Integer, i As Integer, sBer() As String
sBer = Split("A1,C3,D5", ",")
If iTimerID <> 0 Then KillTimer 0, iTimerID: iTimerID = 0
iCur = xlDefault
For i = 0 To UBound(sBer)
Set AC = Range(sBer(i))
With ActiveWindow.ActivePane
On Error Resume Next
R.Left = .PointsToScreenPixelsX(AC.Left)
R.Top = .PointsToScreenPixelsY(AC.Top)
R.Right = .PointsToScreenPixelsX(AC.Offset(0, 1).Left)
R.Bottom = .PointsToScreenPixelsY(AC.Offset(1, 0).Top)
End With
GetCursorPos Pt
If Pt.x > R.Left And Pt.y > R.Top And Pt.x < R.Right And Pt.y < R.Bottom Then
iCur = xlNorthwestArrow: Exit For
End If
DoEvents
Next i
Application.Cursor = iCur
If iTimerID = 0 Then iTimerID = SetTimer(0, 0, 100, AddressOf CheckMouseOverRange)
End Sub
Private Sub Worksheet_Activate()
CheckMouseOverRange
End Sub
Private Sub Worksheet_Deactivate()
If iTimerID <> 0 Then KillTimer 0, iTimerID: iTimerID = 0
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If iTimerID <> 0 Then KillTimer 0, iTimerID: iTimerID = 0
End Sub
Private Sub Workbook_Open()
If ActiveSheet.Name = "Tabelle1" Then CheckMouseOverRange
End Sub