Excel mit VBA ListBox2 in Abhängigkeit von ListBox1 befüllen

[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...

[Klaus-Dieter]

Hallo,

ich glaube nicht, dass das irgend jemand nachbauen wird.

[sveni_lee]

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?

[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.

[sveni_lee]

Leider wird keine Zeile makiert...
bzw nutze ich den Debug eventuell auch nicht richtig...

Ich habe die Datei in den anhang gepackt...

[WillWissen]

Hi sveni,

du musst noch rechts den Button "Attachment bhinzufügen" anklicken.

[Käpt'n Blaubär]

Hallo,

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.

[Steffl]

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

[sveni_lee]

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.

[Steffl]

Hallo,

ich sehe es erst jetzt  :22:  Es heißt Column und nicht Colunm