Zelle unter der Mausposition

Um die Zelle unter der Mausposition zu ermitteln, muss man erst einmal die Mausposition selbst ermitteln. Diese ist aber leider bezogen auf den Bildschirm. Also ermittelt man die Breite und Position des Clientfensters von Excel, welches die eigentliche Tabelle darstellt. Davon werden noch die Scrollbars, Rahmen, Zeilen- und Spaltenköpfe abgezogen und man hat nun endlich den Bereich, in dem sich die Zellen befinden. Nun die sichtbaren Spaltenbreiten und Zeilenhöhen in die Rechnung einbezogen, und man hat die Adresse. Das Makro ruft sich alle zwei Sekunden auf und wenn zwei mal die gleiche Zellposition ermittelt wurde, wird das Ergebnis in der Statusleiste angezeigt.

Beispieldatei (cellpos.zip 30 KB)

Option Explicit
Private 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

Private Declare Function GetWindowRect Lib "user32" _
    (ByVal hwnd As Long, lpRect As RECT) As Long

Private Declare Function GetCursorPos Lib "user32" _
    (lpPoint As POINTAPI) 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 AnAus As Boolean

Sub MauspositionErmitteln()
Dim Fenster As RECT
Dim Mauspos As POINTAPI
Static ZeileVorher&, SpalteVorher&
Dim Zeile&, Spalte&, i&
Dim Breite() As Long, Höhe() As Long
Dim hwndWindow&
Static FaktorX#, FaktorY#
Static hwndMainWindow&, hwndDeskWindow&
If AnAus = False Then Exit Sub
If hwndMainWindow = 0 Then
    ' Handle auf Excel holen
    hwndMainWindow = FindWindowEx(0&, 0&, _
        "XLMAIN", Application.Caption)
    ' Abmessungen in Pixel
    GetWindowRect hwndMainWindow, Fenster
    ' Punktgröße in Pixel
    With Fenster
        FaktorX = (.Right - .Left) / _
            Application.Width
        FaktorY = (.Bottom - .Top) / _
            Application.Height
    End With
    ' Handle auf Clientbereich
    '(XL97). Bei anderen Versionen muss eventuell
    'der Klassenname angepasst werden. Ich habe aber
    'keine Ahnung, ob der überhaupt anders ist und wie
    'der dann lautet.
    hwndDeskWindow = FindWindowEx(hwndMainWindow, _
        0&, "XLDESK", vbNullString)
    If hwndDeskWindow = 0 Then MsgBox "Falscher Klassenname XLDESK"
End If
' Handle auf 1. Window
'(XL97). Bei anderen Versionen muss eventuell
'der Klassenname angepasst werden. Ich habe aber
'keine Ahnung, ob der überhaupt anders ist und wie
'der dann lautet.
hwndWindow = FindWindowEx(hwndDeskWindow, 0&, _
    "EXCEL7", vbNullString)
If hwndWindow = 0 Then MsgBox "Falscher Klassenname EXCEL7"
' Größe ermitteln
GetWindowRect hwndWindow, Fenster
' Mausposition ermitteln
GetCursorPos Mauspos
With Fenster
    ' Wenn Zeilen- und Spaltenköpfe sichtbar sind
    If ActiveWindow.DisplayHeadings = True Then
        'Sichtbaren Bereich 16 Pixel nach unten
        .Top = .Top + 16
        'Sichtbaren Bereich 16 Pixel nach rechts
        .Left = .Left + 16
    End If
    ' Wenn Horizontale Scrollbar oder die
    ' Registerzungen sichtbar sind
    If ActiveWindow.DisplayHorizontalScrollBar = True Or _
        ActiveWindow.DisplayWorkbookTabs = True Then
        'Sichtbaren Bereich 16 Pixel nach oben
        .Bottom = .Bottom - 16
    End If
    ' Wenn Vertikale Scrollbar sichtbar ist
    If ActiveWindow.DisplayVerticalScrollBar = True Then
        'Sichtbaren Bereich 16 Pixel nach links
        .Right = .Right - 16
    End If
    'Sichtbaren Bereich 25 Pixel nach unten
    .Top = Fenster.Top + 25
    'Ränder berücksichtigen
    .Bottom = Fenster.Bottom - 6
    .Left = Fenster.Left + 6
    .Right = Fenster.Right - 6
End With
With ActiveWindow.VisibleRange
    'Überprüfen, ob Maus im sichtbaren Bereich
    If Mauspos.x > (Fenster.Left) And Mauspos.x < _
        (Fenster.Right) Then
        If Mauspos.y > (Fenster.Top) And Mauspos.y < _
            (Fenster.Bottom) Then
            'Array mit den linken und rechten
            'Rändern der Zellen füllen
            ReDim Breite(.Columns.Count, 1 To 2)
            Breite(0, 2) = Fenster.Left
            For i = 1 To .Columns.Count
                Breite(i, 1) = Breite(i - 1, 2)
                Breite(i, 2) = Breite(i, 1) + _
                    .Cells(1, i).Width * FaktorX
            Next
            'Array mit den oberen und unteren
            'Rändern der Zellen füllen
            ReDim Höhe(.Rows.Count, 1 To 2)
            Höhe(0, 2) = Fenster.Top
            For i = 1 To .Rows.Count
                Höhe(i, 1) = Höhe(i - 1, 2)
                Höhe(i, 2) = Höhe(i, 1) + _
                    .Cells(i, 1).Height * FaktorY
            Next
            'Ermitteln, in welcher Spalte Maus
            'sich befindet
            For i = 1 To .Columns.Count
                If Mauspos.x > Breite(i, 1) And _
                    Mauspos.x <= Breite(i, 2) Then
                    Spalte = i
                    Exit For
                End If
            Next
            'Ermitteln, in welcher Zeile Maus
            'sich befindet
            For i = 1 To .Rows.Count
                If Mauspos.y > Höhe(i, 1) And _
                    Mauspos.y <= Höhe(i, 2) Then
                    Zeile = i
                    Exit For
                End If
            Next
        End If
    End If
    If Zeile > 0 And Spalte > 0 Then
        If (ZeileVorher = Zeile) And (SpalteVorher = Spalte) Then
            'Mausposition ausgeben
            Application.StatusBar = ActiveSheet.Name & _
                "!" & .Cells(Zeile, Spalte).Address
        End If
    End If
    ZeileVorher = Zeile: SpalteVorher = Spalte
    'nach zwei Sekunden nochmal aufrufen
    Application.OnTime Now + TimeSerial(0, 0, 2), _
        "MauspositionErmitteln"
End With
End Sub