Toolbox mit Sendkeys und z.B. Drehfeld einfügen

03.03.2025 12:20:34

Dieter(Drummer)

Guten Tag am Rosenmontag an alle.

Mit bisherigem Code wird die Toolbox, Steuerelemente, mit aktivieren des Drehfeldes, von Active-X-Steuerelement, aktiviert. Das funktioniert.
Man muss aber anschließend mit Klick auf irgendeine Zelle das Drehfeld dann einfügen. Auch das funktioniert.

Ich suche die Lösung für:
Nach Aufruf der Toolbox, aktivieren Steuerelement Drehfeld, per Sendkey, soll direkt in aktiver Zelle die Grafik Drehfeld eingefügt werden. Ohne Mausklick.

Fall das möglich ist bitte ich um Hilfe und Codeanpassung.

Mit Gruß,
Dieter(Drummer)
Musterdatei:
https://www.herber.de/bbs/user/176086.xlsm

AW: Toolbox mit Sendkeys und z.B. Drehfeld einfügen

03.03.2025 16:18:17

daniel

Hi
was willst du denn, ActiveX oder Formularfeld?
das D erstellt bei mir das Formularfeld, nicht das ActiveX

Warum verwendest du nicht den direkten Code?
Der Recorder zeichnet bei mir auf.

für das Einfügen eines ActiveX-Drehfeldes in der aktiven Zelle:

With ActiveCell

    ActiveSheet.OLEObjects.Add _

        ClassType:="Forms.SpinButton.1", _

        Link:=False, _

        DisplayAsIcon:=False, _

        Left:=.Left, _

        Top:=.Top, _

        Width:=24, _

        Height:=47.25

End With

und als Formularfeld:

ActiveSheet.Spinners.Add ActiveCell.Left, ActiveCell.Top, 28.5, 55.5

sollte zuverlässiger funktionieren als die Sendkeysmethode.

Gruß Daniel

AW: Toolbox mit Sendkeys und z.B. Drehfeld einfügen

03.03.2025 17:39:34

Dieter(Drummer)

Hallo Daniel und Danke für Rückmeldung und Code.

Mein Code ruft ActiveX Drehfeld auf, dafür DD (Application.SendKeys ("%WIDD").
Wie ich das ohne Sendkey machen kann, ist mir bekannt und funktioniert ja auch mit deinem Code.

Mir geht es einfach darum, wie ich trotz mit Sendkey, den Maustasten Klick dann auslösen kann.
Wenn es nicht geht, muss ich halt den Klick selbst auslösen.

Gruß,
Dieter(Drummer)

AW: Toolbox mit Sendkeys und z.B. Drehfeld einfügen

03.03.2025 21:42:44

Daniel

also bei mir schreibt dein Code IDD in die Zelle
mehr passiert nicht.
Gruß Daniel

AW: Toolbox mit Sendkeys und z.B. Drehfeld einfügen

03.03.2025 23:01:22

Dieter(Drummer)

Hallo Daniel.

dann hast du den Code im VBA Modus aktiviert und das ist falsch.
Du musst den Code bei aktiviertem Tabellenblatt aktivieren.
In meiner Musterdatei brauchst du nur den kleinen grauen Knopf (Klick) anklicken. So wird im Tabellenblatt der Code:

(Application.SendKeys ("%WIDD")

aufgerufen.
% für Alttaste, WI für aktivieren der Toolbox und DD für aktivieren des Drehfeld, Active-X-Steuerelement.
Anschliessend kannst du per Mausklick diese Grafik einfügen. Das klappt prima.

Es fehlt mir halt die Option den Mauklick ebenfalls per Code auszuführen.

Gruß,
Dieter(Drummer)

AW: Toolbox mit Sendkeys und z.B. Drehfeld einfügen

03.03.2025 23:25:21

volti

Hallo Dieter,

<<<Es fehlt mir halt die Option den Mauklick ebenfalls per Code auszuführen.>>>

Einen Mausklick per code lässt sich ganz einfach mit der mouse_event-Funktion erreichen. Ggf. vorher noch die Cursorposition setzen.

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

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

AW: Toolbox mit Sendkeys und z.B. Drehfeld einfügen

04.03.2025 09:50:17

Dieter(Drummer)

Guten Morgen Karl-Heinz.

Dank für Rückmeldung und deinen Code für Mausklick.

Es kommt ein Fehlerhinweis: Fehler beim Kompilieren, "Argument ist nicht optional". Der Codea bricht mit Markierung: "Mausklick", im Code "Test_Toolbox" ab.
Evtl. hast du noch eine Idee, was ich da falsch habe

Mit Gruß,
Dieter(Drummer)

Hier mein jetziger Code im Modul1:

'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

AW: Toolbox mit Sendkeys und z.B. Drehfeld einfügen

04.03.2025 10:08:48

volti

Moin Dieter,

die Sub erwartet die Übergabe der x- und y-Position auf dem Bildschirm, wo der Mausklick erfolgen soll. Das musst Du schon mit angeben.

Mausklick heißt ja, an einer bestimmten Position ein Klickevent auszuführen.

Wenn Du einfach nur einen Linksklick an der momentanen Cursorposition machen willst, kannst Du das so machen.
Aber das ist m.E. dann ein Glücksspiel.



Sub MausKlick()

  mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0

End Sub

Gruß KH

AW: Toolbox mit Sendkeys und z.B. Drehfeld einfügen

04.03.2025 10:20:41

volti

Hallo Dieter,

hier noch eine Version, die im gerade aktiven Feld klickt und die Cursorposition wiederherstellt, so dass der User keinerlei Einschränkungen hat.
Vielleicht bringt Dich dies ja weiter.

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

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

AW: Toolbox mit Sendkeys und z.B. Drehfeld einfügen

04.03.2025 13:12:06

Dieter(Drummer)

Herzlichen Dank Karl_Heinz,

deine Version ist perfekt und wie ich es mir gewünscht habe.
Musste nur "Privat" auf "Public" umstellen und klappt prima.
Danke und noch einen erfolgreichen Tag.

Gruß,
Dieter(Drummer)

Toolbox mit Sendkeys und z.B. Drehfeld einfügen

Forumthread: Toolbox mit Sendkeys und z.B. Drehfeld einfügen

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Toolbox mit Sendkeys und z.B. Drehfeld einfügen

Forumthread: Toolbox mit Sendkeys und z.B. Drehfeld einfügen

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread