Zelle unter der Mausposition #2

Unter Position 58, Zellposition unter dem Mauscursor ermitteln wurde eine Methode dargestellt,  die Zelle unter der Mausposition zu ermitteln,

In diesem Beispiel wird ein ganz anderer Weg gegangen.

Es gibt leider kein MouseMove-Ereignis, das ausgelöst wird, wenn die Maus über ein Tabellenblatt bewegt wird. Verschiedene Steuerelemente bieten aber das Ereignis MouseMove an, mit dem man auch die aktuelle Position der Maus über dem Element feststellen kann.

Dabei wird ein durchsichtiges Bild-Steuerelement so groß wie das sichtbare Tabellenblatt gemacht. Dessen MouseMove-Ereignis wird überwacht und damit die Zelle ermittelt, unter der sich die Maus befindet. Damit man mit dem Tabellenblatt arbeiten kann, wird bei einem Klick auf das Steuerelement das Bildsteuerelement ausgeblendet und die unter dem Mauszeiger befindliche Zelle selektiert

Beispieldatei (MouseMovePic.zip 12 KB)

Option Explicit

Private Sub cmdMousePos_Click()
With imgMouse
   'An- bzw Ausschalten
   .Visible = Not .Visible
   .Left = 0
   .Top = 0
   .Width = ActiveWindow.VisibleRange.Width
   .Height = ActiveWindow.VisibleRange.Height
End With
End Sub

Private Sub imgMouse_MouseMove( _
   ByVal Button As Integer, _
   ByVal Shift As Integer, _
   ByVal X As Single, _
   ByVal Y As Single)
Dim i                      As Long
Static k                   As Long
Static strVisibleRange     As String
Static avarZellPos()       As Variant
Dim rngZelle               As Range
Dim strAktAdress           As String

With ActiveWindow.VisibleRange
   If strVisibleRange <> .Address Then
      ReDim avarZellPos(1 To .Cells.Count, 1 To 5)
      For Each rngZelle In .Cells
         i = i + 1
         With rngZelle
            avarZellPos(i, 1) = .Left
            avarZellPos(i, 2) = (.Left + .Width)
            avarZellPos(i, 3) = .Top
            avarZellPos(i, 4) = (.Top + .Height)
            avarZellPos(i, 5) = .Address
         End With
      Next
      strVisibleRange = .Address
   End If
End With
   
'Ermitteln, über welcher Zelle sich die Maus befindet
For i = 1 To UBound(avarZellPos, 1)
   If X > avarZellPos(i, 1) And _
      X <= avarZellPos(i, 2) Then
      If Y > avarZellPos(i, 3) And _
         Y <= avarZellPos(i, 4) Then
            strAktAdress = avarZellPos(i, 5)
         Exit For
      End If
    End If
Next

With imgMouse
   Select Case Button
      Case Is = xlPrimaryButton
         .Visible = False
         ' Zelle selektieren
         Me.Range(strAktAdress).Select
      Case Is = xlSecondaryButton
         .Visible = False
         ' Kontextmenü Zelle anzeigen
         Application.CommandBars("Cell").ShowPopup
      Case Else
   End Select
End With


'Mausposition ausgeben
Application.StatusBar = strAktAdress


End Sub