Dropdown-Menü ausklappen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Code:

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
Dim Pt As POINTAPI
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)
  
  If Target.Address <> "$F$3" 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
End Sub

Hallo zusammen,

sollten sich viele DropDown-Felder im aktuellen Blatt befinden und das Aufklappen bei allen DropDowns funktionieren gibt es hier eine kleine Ergänzung...

Code:


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 aus Freigericht 😊
Karl-Heinz

Beliebteste Forumthreads (12 Monate)

18 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread