Anzeige
Archiv - Navigation
1648to1652
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Drehfeld mit Schleife?

Drehfeld mit Schleife?
15.10.2018 08:39:22
SebastianMB
Hallo,
mal wieder eine Frage von mir.
Ich habe folgendes Problem.
In Zelle M7 und N7 steht jeweils ein Wert. Dieser soll, mit einem Drehfeld, um 0,1 hoch oder runtergezählt werden können. Also jeweils ein Drehfeld/Button für eine Zelle.
Alle 220 Zeilen soll das gleiche wieder passieren.
Also ein extra Drehfeld/Button für die entsprechenden Zellen.
z.B.
M227 / N227
M447 / N447
………………………………………
M 5067 / N 5067
Ich habe jetzt zwei Kleine Makros geschrieben. Welche ich auf Buttons zuweisen konnte. Für die ersten 2 Zellen. (Siehe unten).
Nun ist mein Problem wie ich diese 2 Makros auf ein Drehfeld anwende und wie ich das mit einer Schleife auf die restlichen übertragen kann. Da ich sonst einen sehr großen Aufwand hätte. Die Drehfelder/Buttons sollen mit einem Makro platziert und erstellt werden. (
Ich hoffe ich habe mich verständlich ausgedrückt und ihr könnt mir weiterhelfen.
Hier das Makro zum Hochzählen:
Sub zaehlen_plus()
Cells(7, 13) = Cells(7, 13) + 0.1
End Sub

Makro zur Positionierung und erstellung:
Sub Erstellung()
Dim t As Range
For i = 6 To 5271 Step 220
Set t = ActiveSheet.Range(Cells(i, 13), Cells(i, 13))
Set btn = ActiveSheet.buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "zaehlen_plus"
.Caption = "+"
.Name = "+"
End With
Next i
For i = 6 To 5271 Step 220
Set t = ActiveSheet.Range(Cells(i + 2, 13), Cells(i + 2, 13))
Set btn = ActiveSheet.buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "zaehlen_minus"
.Caption = "- "
.Name = "-"
End With
Next i
For i = 6 To 5271 Step 220
Set t = ActiveSheet.Range(Cells(i, 14), Cells(i, 14))
Set btn = ActiveSheet.buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "zaehlen_plus_N"
.Caption = "+"
.Name = "+"
End With
Next i
For i = 6 To 5271 Step 220
Set t = ActiveSheet.Range(Cells(i + 2, 14), Cells(i + 2, 14))
Set btn = ActiveSheet.buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "zaehlen_minus_N"
.Caption = "- "
.Name = "-"
End With
Next i
Application.ScreenUpdating = True
End Sub

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

Betreff
Datum
Anwender
Anzeige
Application.Caller
15.10.2018 09:07:15
Beverly
Hi,
meinst du so etwas:
Sub zaehlen_plus()
With ActiveSheet.Shapes(Application.Caller)
Cells(.TopLeftCell.Row, 13) = Cells(.TopLeftCell.Row, 13) + 0.1
End With
End Sub

Übrigens: in deinem Code für das Erstellen der Button musst du die Schleife nicht jedesmal neu durchlaufen sondern kannst alles in eine einzige Schleife packen:
Sub Erstellung()
Dim t As Range
Dim i As Long
Dim btn As Button
For i = 6 To 5271 Step 220
Set t = ActiveSheet.Range(Cells(i, 13), Cells(i, 13))
Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "zaehlen_plus"
.Caption = "+"
.Name = "+"
End With
Set t = ActiveSheet.Range(Cells(i + 2, 13), Cells(i + 2, 13))
Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "zaehlen_minus"
.Caption = "- "
.Name = "-"
End With
Set t = ActiveSheet.Range(Cells(i, 14), Cells(i, 14))
Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "zaehlen_plus_N"
.Caption = "+"
.Name = "+"
End With
Set t = ActiveSheet.Range(Cells(i + 2, 14), Cells(i + 2, 14))
Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "zaehlen_minus_N"
.Caption = "- "
.Name = "-"
End With
Next i
Application.ScreenUpdating = True
End Sub



Anzeige
AW: Drehfeld mit Schleife?
15.10.2018 12:47:48
SebastianMB
Hallo Karin,
mal wieder Vielen Dank für deine Hilfe. Jetzt ergibt sich bei mir jedoch folgendes Problem.
Wenn ich dem Button(Formularsteuerelement) in Zelle M6, das Makro mit dem Application.Caller zuweise. Bekomme ich die Fehlermeldung „typen unverträglich“. An einer anderen Stelle in einer Größe über mehrere Zellen, funktioniert es aber. Woran kann das liegen?
Liebe Grüße
AW: Drehfeld mit Schleife?
15.10.2018 12:52:23
SebastianMB
Ich weiß woran es liegt. Natürlich daran da in der besagten Zelle ein Text steht.
Ich möchte aber das der Button in M6 ist und der veränderbare Wert in M7. Das versuche ich jetzt und falls es nicht funktioniert melde ich mich.
Anzeige
AW: Drehfeld mit Schleife?
15.10.2018 13:16:41
SebastianMB
Also Liebe Karin.
Ich habe es natürlich nicht hinbekommen. Was ich habe ist ein Button in M6 zum hochzählen und einer in M8 zum runterzählen. Die Größe ist so Groß wie die Zelle.
Das mit dem Application.Caller ist eine super Sache. Geht das auch irgendwie in der Art, dass die darunter oder darüber liegende Zelle angesprochen wird.
Ich möchte mich bei dir für die umstände Entschuldigen.
Liebe Grüße
Zeilenzuweisung
15.10.2018 14:30:17
Beverly
Hi Sebastian,
.TopLeftCell.Row ist die Zeile der Zelle, auf der die linke obere Ecke des Buttons liegt - wenn du nicht in dieser sondern in der Zeile darunter hochzählen willst, dann musst du das im Code entsprechend berücksichtigen:
Cells(.TopLeftCell.Row + 1, 13) = Cells(.TopLeftCell.Row + 1, 13) + 0.1


Anzeige
AW: Zeilenzuweisung
16.10.2018 07:59:07
SebastianMB
Hallo Karin,
es tut mir wirklich leid wenn ich langsam nerve. Aber ich habe jetzt das nächste Problem.
Die Button Erstellung für alle Zellen passt soweit. In den Zellen M7 und N7 wird auch richtig gezählt.
Leider Zählen die Buttons in M226/228 und N226/228 ebenfalls die Zellen M7 und N7 und nicht die darunter und darüber liegenden. Das ganze zieht sich über alle folgenden Buttons.
Ich könnte dir auch die Beispieldatei schicken. Über Hilfe wäre ich dir sehr dankbar.
Liebe Grüße
AW: Zeilenzuweisung
16.10.2018 08:06:34
SebastianMB
Hallo Karin,
habe das Makro nochmal geladen, jetzt Funktioniert es. Verstehe ich nicht!
Danke, für deine Hilfe.
Liebe Grüße
Anzeige
Wieder das gleiche Problem!
16.10.2018 09:46:11
SebastianMB
Hallo Karin,
heute ist der Wurm drin. Nach dem ich gespeichert habe, tritt wieder das Problem das nur die Zelle M7/N7 gezählt wird. Das kann doch nicht sein.
Hier die Button Erstellung:
Sub buttons()
Dim btn As Button
Application.ScreenUpdating = False
ActiveSheet.buttons.Delete
Dim t As Range
For i = 6 To 5271 Step 220
Set t = ActiveSheet.Range(Cells(i, 13), Cells(i, 13))
Set btn = ActiveSheet.buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "zaehlen_plus"
.Caption = "+"
.Name = "+"
End With
Next i
For i = 6 To 5271 Step 220
Set t = ActiveSheet.Range(Cells(i + 2, 13), Cells(i + 2, 13))
Set btn = ActiveSheet.buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "zaehlen_minus"
.Caption = "- "
.Name = "-"
End With
Next i
For i = 6 To 5271 Step 220
Set t = ActiveSheet.Range(Cells(i, 14), Cells(i, 14))
Set btn = ActiveSheet.buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "zaehlen_plus_N"
.Caption = "+"
.Name = "+"
End With
Next i
For i = 6 To 5271 Step 220
Set t = ActiveSheet.Range(Cells(i + 2, 14), Cells(i + 2, 14))
Set btn = ActiveSheet.buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "zaehlen_minus_N"
.Caption = "- "
.Name = "-"
End With
Next i
Application.ScreenUpdating = True
End Sub

Hier die Makros für die Buttons:

Sub zaehlen_plus()
With ActiveSheet.Shapes(Application.Caller)
Cells(.TopLeftCell.Row + 1, 13) = Cells(.TopLeftCell.Row + 1, 13) + 0.1
End With
End Sub
Sub zaehlen_minus()
With ActiveSheet.Shapes(Application.Caller)
Cells(.TopLeftCell.Row - 1, 13) = Cells(.TopLeftCell.Row - 1, 13) - 0.1
End With
End Sub
Sub zaehlen_plus_N()
With ActiveSheet.Shapes(Application.Caller)
Cells(.TopLeftCell.Row + 1, 14) = Cells(.TopLeftCell.Row + 1, 14) + 0.1
End With
End Sub

Sub zaehlen_minus_N()
With ActiveSheet.Shapes(Application.Caller)
Cells(.TopLeftCell.Row - 1, 14) = Cells(.TopLeftCell.Row - 1, 14) - 0.1
End With
End Sub

Anzeige
Die Ursache liegt darin...
16.10.2018 12:27:28
Beverly
Hi Sebastian,
...dass du jedem Button denselben Namen zuweist - so sollte es funktionieren:
Sub Erstellung2()
Dim t As Range
Dim i As Long
Dim btn As Button
For i = 6 To 5271 Step 220
Set t = ActiveSheet.Range(Cells(i, 13), Cells(i, 13))
Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "zaehlen_plus"
.Caption = "+"
.Name = "+" & i
End With
Set t = ActiveSheet.Range(Cells(i + 2, 13), Cells(i + 2, 13))
Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "zaehlen_minus"
.Caption = "- "
.Name = "-" & i
End With
Set t = ActiveSheet.Range(Cells(i, 14), Cells(i, 14))
Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "zaehlen_plus_N"
.Caption = "+"
.Name = "+" & i & "N"
End With
Set t = ActiveSheet.Range(Cells(i + 2, 14), Cells(i + 2, 14))
Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.OnAction = "zaehlen_minus_N"
.Caption = "- "
.Name = "-" & i & "N"
End With
Next i
Application.ScreenUpdating = True
End Sub


Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige