DropDown (Datenüberprüfung) bei Aktivierung automatisch aufklappen - Update

[volti]

Hallo Forum,

alternativ zur bekannten Methode, ein DropDown-Objekt aus der Datenüberprüfung per Sendkeys automatisch aufzuklappen, hier eine alternative Lösung mit der Maus, sozusagen als virtueller Mitarbeiter....

Beim Code zum Beitrag vom 07.11.2023 mit gleichem Betreff hatte sich noch ein kleiner Klammerfehler eingeschlichen. Fällt nicht auf, so lange die Excelseite nicht gezoomt ist.
Bei gezoomtem Bildschirm wurde die vertikale Mausposition jedoch falsch berechnet, da Excelpixel anstelle von Screenpixel verwendet wurden.

Code:

Option Explicit

Private Declare PtrSafe Function SetCursorPos Lib "user32" ( _
        ByVal x As Long, ByVal y As Long) As Long
Private Declare PtrSafe Function GetCursorPos Lib "user32" ( _
        lpPoint As POINTAPI) As Long
Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Declare PtrSafe Sub mouse_event Lib "user32" ( _
        ByVal dwFlags As Long, _
        ByVal dx As Long, ByVal dy As Long, _
        ByVal cButtons As Long, ByVal dwExtraInfo As LongPtr)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' Datenüberprüfung (Dropdown) automatisch aufklappen
  Dim Pt As POINTAPI
  
  On Error GoTo Fehler
' Testen, ob Dropdown vorhanden
  If Target.Validation.Type <> xlValidateList Then Exit Sub

  With ActiveWindow.ActivePane
       GetCursorPos Pt              ' Mausposition retten
       SetCursorPos .PointsToScreenPixelsX(Target.Offset(1, 1).Left) + 10, _
                    .PointsToScreenPixelsY(Target.Offset(1, 1).Top) - 10
       mouse_event &H6, 0, 0, 0, 0  ' Buttonclick leftdown + leftup
       SetCursorPos Pt.x, Pt.y      ' Alte Mausposition wiederherstellen
  End With
Fehler:
End Sub

_________
viele Grüße
Karl-Heinz