Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.
Clever-Excel-Forum › Office-Anwendungen › Excel v
Excel mit VBA ListBox2 in Abhängigkeit von ListBox1 befüllen

Thema geschlossen 
Baumstrukturmodus
Excel mit VBA ListBox2 in Abhängigkeit von ListBox1 befüllen
sveni_lee Offline
CEF Einsteiger
*
Registriert seit: 18.06.2019
Version(en): 2013
#1
18.06.2019, 15:17 (Dieser Beitrag wurde zuletzt bearbeitet: 18.06.2019, 15:31 von sveni_lee.)
Hallo zusammen,

ich versuche grad eine eine Eingabemaske zu erstellen. ich möchte das hierbei eine ListBox_Uebung in Abhängigkeit
von der ListBox_Muskelgruppe befüllt wird.

Dazu habe ich ein Arbeitsblatt erstellt, in dem jeder Muskelgruppe entsprechende Uebungen zugeordnet sind.

men code sieht nun folgendermaßen aus:


Code:
Private Sub Button_Abbrechen_Click()

Unload Me

End Sub

Private Sub Button_Eingabe_Click()

'Erste freie Zeile ausfindig machen
Dim last As Integer
last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1

'KW
Cells(last, 1).Value = ComboBox_KW

'Wochentag
Cells(last, 2).Value = ListBox_Wochentag

'Training
Cells(last, 4).Value = ListBox_Training

'Muskelgruppe
Cells(last, 5).Value = ListBox_Muskelgruppe

'Übung
Cells(last, 6).Value = ListBox_Uebung

'Satz
If OptionButton_Satz1.Value = True Then Cells(last, 7).Value = "Satz 1"
If OptionButton_Satz2.Value = True Then Cells(last, 7).Value = "Satz 2"
If OptionButton_Satz3.Value = True Then Cells(last, 7).Value = "Satz 3"
If OptionButton_Satz4.Value = True Then Cells(last, 7).Value = "Satz 4"

'Gewicht
If ListBox_Training = "Cardio" Then Cells(last, 8).Value = ""
If ListBox_Training = "Muskelaufbau" Then Cells(last, 8).Value = TextBox_Gewicht

'Wiederholung
If ListBox_Training = "Cardio" Then Cells(last, 9).Value = ""
If ListBox_Training = "Muskelaufbau" Then Cells(last, 9).Value = TextBox_Wdhlg

'Intervall
If OptionButton_Interv1.Value = True Then Cells(last, 10).Value = "Intervall 1"
If OptionButton_Interv2.Value = True Then Cells(last, 10).Value = "Intervall 2"
If OptionButton_Interv3.Value = True Then Cells(last, 10).Value = "Intervall 3"
If OptionButton_Interv4.Value = True Then Cells(last, 10).Value = "Intervall 4"
If OptionButton_Interv5.Value = True Then Cells(last, 10).Value = "Intervall 5"
If OptionButton_Interv6.Value = True Then Cells(last, 10).Value = "Intervall 6"

'Strecke
Cells(last, 11).Value = TextBox_Strecke

'Zeit
If ListBox_Training = "Cardio" Then Cells(last, 12).Value = TextBox_Zeit
If ListBox_Training = "Muskelaufbau" Then Cells(last, 12).Value = ""

'Jahr
Cells(last, 13).Value = ComboBox_Jahr

End Sub

Private Sub Label1_Click()

End Sub

Private Sub ListBox_Muskelgruppe_Click()

ListBox_Uebung.Clear
For k = 2 To ThisWorkbook.Worksheets("Tabelle1").Cells(Cells.Rows.Count, ListBox_Muskelgruppe.ListIndex + 1).End(xlUp).Row
   LisBox_Uebung.AddItem ThisWorkbook.Worksheets("Tabelle1").Cells(k, ListBox_Muskelgruppe.ListIndex + 1)
Next

End Sub

Private Sub SpinButton_Gewicht_Change()

TextBox_Gewicht.Text = SpinButton_Gewicht.Value

End Sub

Private Sub SpinButton_Wdhlg_Change()

TextBox_Wdhlg.Text = SpinButton_Wdhlg.Value

End Sub

Private Sub SpinButton_Zeit_Change()

TextBox_Zeit.Text = SpinButton_Zeit.Value

End Sub

Private Sub UserForm_Initialize()

For k = 1 To ThisWorkbook.Worksheets("Tabelle1").Cells(1, Cells.Columns.Count).End(xlToLeft).Colunm
   ListBox_Muskelgruppe.AddItem ThisWorkbook.Worksheets("Tabelle1").Cells(1, k)
Next

'KW
Dim i As Integer

With ComboBox_KW
   For i = 1 To 52
       .AddItem CInt(i)
   Next
End With
       

'Wochentag
With ListBox_Wochentag
   .AddItem "Montag"
   .AddItem "Dienstag"
   .AddItem "Mittwoch"
   .AddItem "Donnerstag"
   .AddItem "Freitag"
   .AddItem "Samstag"
   .AddItem "Sonntag"
End With

'Training
With ListBox_Training
   .AddItem "Muskelaufbau"
   .AddItem "Cardio"
End With

'Muskelgruppe
'With ListBox_Muskelgruppe
'    .AddItem "Arme"
'    .AddItem "Bauch"
'    .AddItem "Beine"
'    .AddItem "Brust"
'    .AddItem "Rücken"
'    .AddItem "Schulter"
'End With

'Übung

'With ListBox_Uebung
'    .AddItem "Abduktionsmaschine"
'    .AddItem "Adduktionmaschine"
'    .AddItem "Bauchbank"
'    .AddItem "Bauchpresse"
'    .AddItem "Beinbeuger"
'    .AddItem "Beinpresse"
'    .AddItem "Bizepsmaschiene"
'    .AddItem "Brustmaschiene"
'    .AddItem "Butterfly"
'    .AddItem "Butterfly reverse"
'    .AddItem "DIP-Maschiene"
'    .AddItem "Latzugmaschiene"
'    .AddItem "Medizinball/Crunches"
'    .AddItem "Popresse"
'    .AddItem "Rückenstrecker"
'    .AddItem "Ruderzugmaschiene"
'    .AddItem "Seithebemaschiene"
'    .AddItem "Trizepsmaschiene"
'    .AddItem "Twistermaschiene"
'    .AddItem "Wadenmaschiene"
'End With

'Satz

'Gewicht
SpinButton_Gewicht.Min = 20
SpinButton_Gewicht.Value = 20
TextBox_Gewicht.Text = SpinButton_Gewicht.Value

'Wiederholung
SpinButton_Wdhlg.Min = 1
SpinButton_Wdhlg.Value = 1
TextBox_Wdhlg.Text = SpinButton_Wdhlg.Value


'Intervall

'Strecke

'Zeit
SpinButton_Zeit.Min = 20
SpinButton_Zeit.Value = 20
TextBox_Zeit.Text = SpinButton_Zeit.Value

'Jahr
Dim j As Integer

With ComboBox_Jahr
   For j = 2019 To 2025
       .AddItem CInt(j)
   Next
End With

End Sub

Ich bekomme aber immer einen Laufzeitfehler 438 angezeigt.
Irgendwie komm ichnicht mehr weiter...
Suchen
Antworten Top
Klaus-Dieter Offline
Excel und VBA
Registriert seit: 11.04.2014
Version(en): Office 365
#2
18.06.2019, 15:46
Hallo,

ich glaube nicht, dass das irgend jemand nachbauen wird.
Viele Grüße
Klaus-Dieter
Der Erfolg hat viele Väter, 
der Misserfolg ist ein Waisenkind
Richard Cobden
Homepage Suchen
Antworten Top
sveni_lee Offline
CEF Einsteiger
ThreadStarter
*
Registriert seit: 18.06.2019
Version(en): 2013
#3
18.06.2019, 15:58
Das Problem tritt nur auf wenn ic diese beiden Abschnitte einfüge:


Code:
Private Sub ListBox_Muskelgruppe_Click()

ListBox_Uebung.Clear
For k = 2 To ThisWorkbook.Worksheets("Tabelle1").Cells(Cells.Rows.Count, ListBox_Muskelgruppe.ListIndex + 1).End(xlUp).Row
  LisBox_Uebung.AddItem ThisWorkbook.Worksheets("Tabelle1").Cells(k, ListBox_Muskelgruppe.ListIndex + 1)
Next

End Sub

Code:
Private Sub UserForm_Initialize()

For k = 1 To ThisWorkbook.Worksheets("Tabelle1").Cells(1, Cells.Columns.Count).End(xlToLeft).Colunm
  ListBox_Muskelgruppe.AddItem ThisWorkbook.Worksheets("Tabelle1").Cells(1, k)
Next

.
.
.
End Sub
also muss es damit zusammenhängen, oder?
Suchen
Antworten Top
Glausius Offline
CEF-Moderator
Registriert seit: 11.04.2014
Version(en): 2021
#4
18.06.2019, 15:58 (Dieser Beitrag wurde zuletzt bearbeitet: 18.06.2019, 16:01 von Glausius.)
Hallo,

wie Klaus-Dieter schon schrieb: "Es wird wohl niemand das nachbauen wollen!", deshalb

1. Stelle deine Musterdatei hier ein   und
2. In welcher Zeile wird dir denn der Laufzeitfehler 438 angezeigt und was ist markiert?

Unsere Glaskugeln zeigen nämlich nichts an - schade, so sind wir auf seine spezifischen Infos angewiesen!

Upps! Das war zur gleichen Zeit! Damit dürfte sich 2. erledigt haben.
[Bild: attachment-190.gif]
Gruß Günter
aus der Helden-, Messe-, Musik-, Buch-, Universitäts- und Autostadt Leipzig
Suchen
Antworten Top
sveni_lee Offline
CEF Einsteiger
ThreadStarter
*
Registriert seit: 18.06.2019
Version(en): 2013
#5
18.06.2019, 16:12
Leider wird keine Zeile makiert...
bzw nutze ich den Debug eventuell auch nicht richtig...

Ich habe die Datei in den anhang gepackt...
Suchen
Antworten Top
WillWissen Offline
CEF-Moderator
Registriert seit: 10.04.2014
Version(en): Microsoft 365, mtl. Kanal
#6
18.06.2019, 16:17
Hi sveni,

du musst noch rechts den Button "Attachment bhinzufügen" anklicken.
Gruß Günter
Jeder Fehler erscheint unglaublich dumm, wenn andere ihn begehen.
angebl. von Georg Christoph Lichtenberg (1742-1799)
Suchen
Antworten Top
Käpt'n Blaubär Offline
Benutzer
Registriert seit: 11.04.2014
Version(en): '97 bis 2016; 365
#7
18.06.2019, 16:17
Hallo,

Zitat:Ich habe die Datei in den anhang gepackt...

... wird aber erst dann interessant für uns, wenn Du es auch noch schaffst,
auf "Attachment hinzufügen" zu klicken.
________________________________________________________________________
wer aufgibt, ohne es versucht zu haben, gibt einfach nur auf!

Grüße aus Norderstedt, Peter
Suchen
Antworten Top
Steffl Offline
Excelanwender
Registriert seit: 11.04.2014
Version(en): Office 2007
#8
18.06.2019, 18:26
Auch Hallo,

hänge beim Userform-Initialize-Code beim Cells noch ein Vakue dran

Code:
Private Sub UserForm_Initialize()

For k = 1 To ThisWorkbook.Worksheets("Tabelle1").Cells(1, Cells.Columns.Count).End(xlToLeft).Colunm
  ListBox_Muskelgruppe.AddItem ThisWorkbook.Worksheets("Tabelle1").Cells(1, k).Value
Next
Gruß Stefan
Win 10 / Office 2016
Suchen
Antworten Top
sveni_lee Offline
CEF Einsteiger
ThreadStarter
*
Registriert seit: 18.06.2019
Version(en): 2013
#9
19.06.2019, 07:08
(18.06.2019, 18:26)Steffl schrieb: Auch Hallo,

hänge beim Userform-Initialize-Code beim Cells noch ein Vakue dran

Code:
Private Sub UserForm_Initialize()

For k = 1 To ThisWorkbook.Worksheets("Tabelle1").Cells(1, Cells.Columns.Count).End(xlToLeft).Colunm
 ListBox_Muskelgruppe.AddItem ThisWorkbook.Worksheets("Tabelle1").Cells(1, k).Value
Next

das hat leider nicht geholfen...

Aber ich versuche noch einmal den Anhang richtig hinzuzufügen. Smile


Angehängte Dateien
.xlsm   Trainingsplan_Test.xlsm (Größe: 35,99 KB / Downloads: 6)
Suchen
Antworten Top
Steffl Offline
Excelanwender
Registriert seit: 11.04.2014
Version(en): Office 2007
#10
19.06.2019, 07:24
Hallo,

ich sehe es erst jetzt  :22:  Es heißt Column und nicht Colunm
Gruß Stefan
Win 10 / Office 2016
Suchen
Antworten Top
Thema geschlossen 


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste