With ActiveCell
ActiveSheet.OLEObjects.Add _
ClassType:="Forms.SpinButton.1", _
Link:=False, _
DisplayAsIcon:=False, _
Left:=.Left, _
Top:=.Top, _
Width:=24, _
Height:=47.25
End With
ActiveSheet.Spinners.Add ActiveCell.Left, ActiveCell.Top, 28.5, 55.5
(Application.SendKeys ("%WIDD")
aufgerufen.
Code: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) Declare PtrSafe Function SetCursorPos Lib "user32" ( _ ByVal x As Long, ByVal y As Long) As Long Const MOUSEEVENTF_LEFTDOWN As Long = &H2 Const MOUSEEVENTF_LEFTUP As Long = &H4 Sub MausKlick(mCX As Long, mCY As Long) ' Linke Maustaste an x,y-Position klicken SetCursorPos mCX, mCY ' Position setzen mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0 End Sub
'Herber: volti (Karl_Heinz) 03.03.2025 22:25:21
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)
Declare PtrSafe Function SetCursorPos Lib "user32" ( _
ByVal x As Long, ByVal y As Long) As Long
Const MOUSEEVENTF_LEFTDOWN As Long = &H2
Const MOUSEEVENTF_LEFTUP As Long = &H4
Sub MausKlick(mCX As Long, mCY As Long)
' Linke Maustaste an x,y-Position klicken
SetCursorPos mCX, mCY ' Position setzen
mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub
Sub Test_Tollbox()
Application.SendKeys ("%WIDD")
SendKeys ("{enter}")
MausKlick
End Sub
Sub MausKlick()
mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub
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 MausKickInActiveCell() ' Mausklick im aktuellen Feld ausführen Dim Pt As POINTAPI With ActiveWindow.ActivePane GetCursorPos Pt ' Mausposition retten SetCursorPos .PointsToScreenPixelsX(ActiveCell.Left) + 10, _ .PointsToScreenPixelsY(ActiveCell.Top) + 10 mouse_event &H6, 0, 0, 0, 0 ' Buttonclick leftdown + leftup SetCursorPos Pt.x, Pt.y ' Alte Mausposition wiederherstellen End With End Sub