Combobox in Userform
07.09.2016 11:49:02
Alex
ich habe mich an einem Anlagenkataster probiert.
Bin mit der Funktionalität bis dato recht zufrieden, wobei ich ein Problem mit meinen Comboboxen in der Userform bekomme.
Die Aufmachung wird deutlich in der angehängten Datei.
Habe folgenden Code:
Option Explicit
Option Compare Text
Private Sub ComboBox1_Click()
With Me.ComboBox1
.AddItem " "
.AddItem "Ja"
.AddItem "Nein"
.ListIndex = 1
End With
End Sub
Private Sub CommandButton1_Click()
Dim lZeile As Long
lZeile = 2
Do While Trim(CStr(Tabelle9.Cells(lZeile, 1).Value)) ""
lZeile = lZeile + 1
Loop
Tabelle9.Cells(lZeile, 1) = CStr("Neuer Eintrag Zeile " & lZeile)
ListBox1.AddItem CStr("Neuer Eintrag Zeile " & lZeile)
ListBox1.ListIndex = ListBox1.ListCount - 1
End Sub
Private Sub CommandButton2_Click()
Dim lZeile As Long
If ListBox1.ListIndex = -1 Then Exit Sub
lZeile = 2
Do While Trim(CStr(Tabelle9.Cells(lZeile, 1).Value)) ""
If ListBox1.Text = Trim(CStr(Tabelle9.Cells(lZeile, 1).Value)) Then
Tabelle9.Rows(CStr(lZeile & ":" & lZeile)).Delete
Call UserForm_Initialize
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
Exit Do
End If
lZeile = lZeile + 1
Loop
End Sub
Private Sub CommandButton3_Click()
Dim lZeile As Long
If ListBox1.ListIndex = -1 Then Exit Sub
If Trim(CStr(TextBox1.Text)) = "" Then
MsgBox "Sie müssen mindestens einen Namen eingeben!", vbCritical + vbOKOnly, "FEHLER!"
Exit Sub
End If
lZeile = 2
Do While Trim(CStr(Tabelle9.Cells(lZeile, 1).Value)) ""
If ListBox1.Text = Trim(CStr(Tabelle9.Cells(lZeile, 1).Value)) Then
Tabelle9.Cells(lZeile, 1).Value = Trim(CStr(TextBox1.Text))
Tabelle9.Cells(lZeile, 2).Value = TextBox2.Text
Tabelle9.Cells(lZeile, 3).Value = TextBox3.Text
Tabelle9.Cells(lZeile, 4).Value = TextBox4.Text
Tabelle9.Cells(lZeile, 5).Value = TextBox5.Text
Tabelle9.Cells(lZeile, 6).Value = TextBox6.Text
Tabelle9.Cells(lZeile, 7).Value = TextBox7.Text
Tabelle9.Cells(lZeile, 8).Value = TextBox8.Text
Tabelle9.Cells(lZeile, 9).Value = TextBox9.Text
Tabelle9.Cells(lZeile, 10).Value = TextBox10.Text
Tabelle9.Cells(lZeile, 12).Value = TextBox11.Text
Tabelle9.Cells(lZeile, 14).Value = TextBox12.Text
Tabelle9.Cells(lZeile, 16).Value = TextBox13.Text
Tabelle9.Cells(lZeile, 18).Value = TextBox14.Text
Tabelle9.Cells(lZeile, 20).Value = TextBox15.Text
Tabelle9.Cells(lZeile, 22).Value = TextBox16.Text
Tabelle9.Cells(lZeile, 24).Value = TextBox17.Text
Tabelle9.Cells(lZeile, 26).Value = TextBox18.Text
Tabelle9.Cells(lZeile, 28).Value = TextBox19.Text
Tabelle9.Cells(lZeile, 30).Value = TextBox20.Text
Tabelle9.Cells(lZeile, 32).Value = TextBox21.Text
Tabelle9.Cells(lZeile, 34).Value = TextBox22.Text
If ListBox1.Text Trim(CStr(TextBox1.Text)) Then
Call UserForm_Initialize
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End If
Exit Do
End If
lZeile = lZeile + 1
Loop
End Sub
Private Sub CommandButton4_Click()
Unload Me
End Sub
Private Sub ListBox1_Click()
Dim lZeile As Long
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox5 = ""
TextBox6 = ""
TextBox7 = ""
TextBox8 = ""
TextBox9 = ""
TextBox10 = ""
TextBox11 = ""
TextBox12 = ""
TextBox13 = ""
TextBox14 = ""
TextBox15 = ""
TextBox16 = ""
TextBox17 = ""
TextBox18 = ""
TextBox19 = ""
TextBox20 = ""
TextBox21 = ""
TextBox22 = ""
TextBox23 = ""
TextBox24 = ""
ComboBox1 = " "
If ListBox1.ListIndex >= 0 Then
lZeile = 2
Do While Trim(CStr(Tabelle9.Cells(lZeile, 1).Value)) ""
If ListBox1.Text = Trim(CStr(Tabelle9.Cells(lZeile, 1).Value)) Then
TextBox1 = Trim(CStr(Tabelle9.Cells(lZeile, 1).Value))
TextBox2 = Tabelle9.Cells(lZeile, 2).Value
TextBox3 = Tabelle9.Cells(lZeile, 3).Value
TextBox4 = Tabelle9.Cells(lZeile, 4).Value
TextBox5 = Tabelle9.Cells(lZeile, 5).Value
TextBox6 = Tabelle9.Cells(lZeile, 6).Value
TextBox7 = Tabelle9.Cells(lZeile, 7).Value
TextBox8 = Tabelle9.Cells(lZeile, 8).Value
TextBox9 = Tabelle9.Cells(lZeile, 9).Value
TextBox10 = Tabelle9.Cells(lZeile, 10).Value
TextBox11 = Tabelle9.Cells(lZeile, 12).Value
TextBox12 = Tabelle9.Cells(lZeile, 14).Value
TextBox13 = Tabelle9.Cells(lZeile, 16).Value
TextBox14 = Tabelle9.Cells(lZeile, 18).Value
TextBox15 = Tabelle9.Cells(lZeile, 20).Value
TextBox16 = Tabelle9.Cells(lZeile, 22).Value
TextBox17 = Tabelle9.Cells(lZeile, 24).Value
TextBox18 = Tabelle9.Cells(lZeile, 26).Value
TextBox19 = Tabelle9.Cells(lZeile, 28).Value
TextBox20 = Tabelle9.Cells(lZeile, 30).Value
TextBox21 = Tabelle9.Cells(lZeile, 32).Value
TextBox22 = Tabelle9.Cells(lZeile, 34).Value
TextBox23 = Tabelle9.Cells(lZeile, 1).Value
TextBox24 = Tabelle9.Cells(lZeile, 4).Value
ComboBox1 = Tabelle9.Cells(lZeile, 11).Value
Exit Do
End If
lZeile = lZeile + 1
Loop
End If
End Sub
Private Sub TextBox10_Change()
'Sheets("Gebäudekennwerte").Range("J9").Value = Me.TextBox10.Value
End Sub
Private Sub TextBox23_Change()
TextBox23.Locked = True
End Sub
Private Sub TextBox24_Change()
TextBox24.Locked = True
End Sub
Private Sub UserForm_Activate()
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End Sub
Private Sub UserForm_Initialize()
Dim lZeile As Long
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox5 = ""
TextBox6 = ""
TextBox7 = ""
TextBox8 = ""
TextBox9 = ""
TextBox10 = ""
TextBox11 = ""
TextBox12 = ""
TextBox13 = ""
TextBox14 = ""
TextBox15 = ""
TextBox16 = ""
TextBox17 = ""
TextBox18 = ""
TextBox19 = ""
TextBox20 = ""
TextBox21 = ""
TextBox22 = ""
TextBox23 = ""
TextBox24 = ""
ComboBox1 = " "
ListBox1.Clear
lZeile = 2
Do While Trim(CStr(Tabelle9.Cells(lZeile, 1).Value)) ""
ListBox1.AddItem Trim(CStr(Tabelle9.Cells(lZeile, 1).Value))
lZeile = lZeile + 1
Loop
End Sub
1. Leerzeichen
2. Ja
3. Nein
Diese sollen ebenfalls dynamisch in meine Liste übertragen werden.
Ich war schon an dem Punkt das in den Comboboxen diese Möglichkeiten aufgelistet werden, jedoch wurde die Auswahlliste durch wiederholtes Klicken der Schaltfläche dupliziert, sodass ich immer wieder diese 3 Argumente zusätzlich in meine Auswahlbox erhalte - ich denke das das keiner genau versteht, es sieht dann nach mehrfachen Klicken im Auswahlfenster folgendermaßen aus:
1.
2. Ja
3. Nein
1.
2. Ja
3. Nein
1.
2. Ja
3. Nein
1.
2. Ja
3. Nein
etc...
https://www.herber.de/bbs/user/108064.xlsm
Ich hoffe, dass mir da einer unter die Arme greifen kann.
Viele Grüße
Alex