Office: Drehfelder / SpinButtons incl. Zellverknüpfung kopieren

Hallo liebes Forum,

bin neu hier und habe gleich ein - für mich - unlösbares Problem:
Ich möchte mehrere Drehfelder in einer Excel-Liste anlegen und diese jeweils mit den Feldern verknüpfen, auf welchen die Drehfelder liegen. Am besten noch mit Min- und Max-Wert-Definition.

Bei der Suche hier bin ich auf ein ähnliches Problem nur mit Kontrollkästchen gestoßen. Das klappt auch perfekt:

Code:

Private Sub CommandButton1_Click()

 Dim lngZeile As Long
   Dim intSpalte As Integer
   For lngZeile = 2 To 4 '<== Zeilenanzahl anpassen
      For intSpalte = 2 To 7 '<== Spaltenanzahl anpassen
         With ActiveSheet.CheckBoxes.Add(Cells(lngZeile, intSpalte).Left, _
            Cells(lngZeile, intSpalte).Top, Columns(intSpalte).Width, _
            Rows(lngZeile).Height - 0.05)
            .Text = lngZeile & " - " & intSpalte
            .LinkedCell = Cells(lngZeile, intSpalte).Address
         End With
      Next intSpalte
   Next lngZeile


End Sub

(Vielen lieben Dank an den Beitrag von Karin / Beverly)

Allerdings bekomme ich das Beispiel nicht auf Drehfelder umgestrickt. Wenn ich an Stelle von "CheckBoxes" den Begriff "SpinButtons" einfüge, bekomme ich einen Objekt-Fehler.

Kann hier jemand helfen, bzw. ist es möglich, dass es nur mit Kontrollkästchen geht, aber nicht mit Drehfeldern?
Vielen Dank schonmal im Voraus und

viele Grüße
Christian

 

Hi Christian,

die Formular-Drehfelder (oder SpinButton) heißen in VBA nicht "SpinButton" sondern "Spinners":

Code:

Private Sub CommandButton1_Click()
   Dim lngZeile As Long
   Dim intSpalte As Integer
   For lngZeile = 2 To 4 '<== Zeilenanzahl anpassen
      For intSpalte = 2 To 7 '<== Spaltenanzahl anpassen
         With ActiveSheet.Spinners.Add(Cells(lngZeile, intSpalte).Left, _
            Cells(lngZeile, intSpalte).Top, Columns(intSpalte).Width, _
            Rows(lngZeile).Height - 0.05)
            .LinkedCell = Cells(lngZeile, intSpalte).Address
            .Min = 1
            .Max = 100
         End With
      Next intSpalte
   Next lngZeile
End Sub

---

 

Hey Karin,

AAHHH, vielen Dank für den entscheidenden Hinweis. Das mit den Spinners muss man erstmal wissen...

Gibt es auch die Möglichkeit, alle SpinButtons eines Tabellenblattes mit der Zelle zu verknüpfen, in der sie liegen?

Ich bin in VBA leider noch nicht wirklich bewandert. Habe mich bisher nur ziemlich exzessiv mit Excel-Formeln beschäftigt.

Viele Grüße
Christian

 

Hi Christian,

das geht auf diesem Weg:

Code:

Sub Zellzuweisung()
    Dim spSpin As Spinner
    For Each spSpin In ActiveSheet.Spinners
        spSpin.LinkedCell = spSpin.TopLeftCell.Address
    Next spSpin
End Sub

---

 

Hallo Karin,

vielen lieben Dank für den Code. Hat alles super geklappt und funktioniert :-).
Habe den Code noch um ein paar Zeilen ergänzt, was Vorbelegung der MIN- / MAX-Werte angeht. Außerdem noch eine Abfrage, ob ein Drehfeld bereits mit der entsprechenden Zelle verknüpft ist. Dann wird der Zellwert als Wert in das Drehfeld geschrieben. Andernfalls wird die Zelle mit dem Drehfeld verknüpft und der Zellinhalt auf "Leer" gesetzt. Sonst stehen dort lauter hässliche Nullen.

Falls es sonst noch jemand interessiert bzw. brauchen kann, hier noch der ergänzte Code:

Code:

Dim spSpin As Spinner
    For Each spSpin In ActiveSheet.Spinners
    
        spSpin.Min = 0
        spSpin.Max = 20
        spSpin.SmallChange = 1
        If spSpin.TopLeftCell.Value > 0 Then
            spSpin.LinkedCell = spSpin.TopLeftCell.Address
            spSpin.Value = spSpin.TopLeftCell.Value
        Else
            spSpin.LinkedCell = spSpin.TopLeftCell.Address
            spSpin.TopLeftCell.Value = ""
        End If
        
    Next spSpin

Den Code natürlich noch in die entsprechende SUB packen.
Dank nochmal an Karin für die "Basisarbeit" und Aufklärung für mich als blutiger Anfänger und

viele Grüße
Christian

 

Hi Christian,

wenn ich dein Anliegen richtig verstanden habe, dann sollte dieses ausreichend sein:

Code:

    Dim spSpin As Spinner
    For Each spSpin In ActiveSheet.Spinners
        spSpin.Min = 0
        spSpin.Max = 20
        spSpin.LinkedCell = spSpin.TopLeftCell.Address
        spSpin.Value = spSpin.TopLeftCell.Value
    Next spSpin

smallChange = 1 ist Standard.

---