Private Sub cmbUebernehmen_Click()
Dim dm As Worksheet '? neu eingefügt
Set dm = ThisWorkbook.Worksheets("DatenMA") ' Datenblatt, auf dem die Daten gespeichert sind
'Schleife über alle ausgewählten Einträge in ListboxStMich
Dim i As Integer
For i = 0 To ListBoxStMich.listCount - 1
If ListBoxStMich.Selected(i) Then
'Hinzufügen einer neuen Zeile zur ListboxUebertrag
Dim newRow As Integer
newRow = ListBoxUebertrag.listCount
ListBoxUebertrag.AddItem ""
'Berechnen der vertikalen Position der Combobox und des Textfelds
Dim topPos As Integer
Dim leftPos As Integer
If newRow = 0 Then
topPos = 190
leftPos = 400
Else
topPos = 190 + 20 * newRow
leftPos = 400
End If
'Hinzufügen der Combobox zur neuen Zeile
Dim newCombo As MSForms.ComboBox
Set newCombo = Me.Controls.Add("Forms.ComboBox.1", "Combo" & newRow, True)
newCombo.Top = topPos
newCombo.Left = leftPos
newCombo.Width = 80
newCombo.height = 15
newCombo.BorderStyle = fmBorderStyleSingle
'** neu Spalte 3 aus Listenfeld, wenn aktiv!
If ListBoxStMich.List(i, 2) > Empty Then _
newCombo.Text = ListBoxStMich.List(i, 2)
'Hinzufügen des Textfelds zur neuen Zeile
Dim newText As MSForms.textBox
Set newText = Me.Controls.Add("Forms.TextBox.1", "Text" & newRow, True)
newText.Top = topPos
newText.Left = leftPos + 100
newText.Width = 100
newText.height = 15
newText.BorderStyle = fmBorderStyleSingle
'** neu Spalte 5 aus Listenfeld
newText.Text = ListBoxStMich.List(i, 4)
If newText.Text = "" Then newText.Text = ws.Range("E2").Value
'Setzen der Optionen für die Combobox
Dim dataRange As Range
Set dataRange = ThisWorkbook.Worksheets("Daten2").Range("A1:A6")
Dim dataCell As Range
For Each dataCell In dataRange
newCombo.AddItem dataCell.Value
Next dataCell
'Kopieren des ausgewählten Eintrags aus ListboxStMich in ListboxUebertrag
ListBoxUebertrag.List(newRow, 0) = ListBoxStMich.List(i)
'Selected Zeile löschen
ListBoxStMich.Selected(i) = False
End If
Next i
End Sub
Private Sub cmbDaten_Click()
Dim i As Integer
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Standesliste") ' Arbeitsblatt, auf das die Daten übertragen werden sollen
' Zellbereich A7:A23 löschen
ws.Range("A7:C23").ClearContents
' Schleife durch alle Einträge in ListboxUebertrag
For i = 0 To ListBoxUebertrag.listCount - 1
' Eintrag in Zelle A7+i schreiben
'** Spalte B+C aus TextBoxen füllen!!
ws.Range("A7").Offset(i, 0).Value = ListBoxUebertrag.List(i)
ws.Range("A7").Offset(i, 1).Value = Me.Controls("Dropdown" & i + 1)
ws.Range("A7").Offset(i, 2).Value = Me.Controls("Textbox" & i + 1)
Next i
Unload Me
End Sub
Private Sub cmbloeschen_Click()
Dim i As Integer
Dim j As Integer
' Schleife durch ListBoxUebertrag, um ausgewählte Optionen zu entfernen
For j = ListBoxUebertrag.listCount - 1 To 0 Step -1
If ListBoxUebertrag.Selected(j) Then
ListBoxUebertrag.RemoveItem j
End If
Next j
End Sub
Private Sub UserForm_Initialize()
Dim ws As Worksheet
Dim dm As Worksheet
Dim i As Integer
'Listbox befüllen
ListBoxStMich.RowSource = "DatenMa!" & Range("tblMa").Address
'** neu eingefügt zum DropDwon Initialisieren!
Set dm = ThisWorkbook.Worksheets("DatenMA") ' Datenblatt, auf dem die Daten gespeichert sind
Set ws = ThisWorkbook.Worksheets("Standesliste") ' Arbeitsblatt, auf dem die Daten gespeichert sind
' Schleife durch alle Einträge in der Tabelle und füge sie der ListBoxUebertrag hinzu
For i = 7 To 23 ' Zeilen, in denen die Daten gespeichert sind
If Not IsEmpty(ws.Range("A" & i)) Then
ListBoxUebertrag.AddItem ws.Range("A" & i).Value
' Erstelle Textbox und setze den Wert aus der Tabelle
Me.Controls.Add "Forms.TextBox.1", "Textbox" & i, True
With Me.Controls("Textbox" & i)
.Top = 190 + (i - 7) * 20
.Left = 500
.Width = 100
.height = 15 '** neu eingefügt
.Value = ws.Range("C" & i).Value
'** Wenn Value leer aus DatenM füllen!
If .Value = "" Then .Value = dm.Range("E2").Value
End With
' Erstelle Dropdown-Feld und setze den Wert aus der Tabelle
Me.Controls.Add "Forms.ComboBox.1", "Dropdown" & i, True
With Me.Controls("Dropdown" & i)
.Top = 190 + (i - 7) * 20
.Left = 400
.Width = 80
.height = 15
' Füllen Sie das Dropdown-Feld mit Werten aus der Tabelle
.List = dm.Range("F2:F7").Value '** aus DatenM laden!!
.Value = ws.Range("B" & i).Value
nx: End With
End If
Next i
End Sub