Es geht darum, dass es bei einem Gruppenleiterwechsel keine Schreib und Eingabefehler geben kann, deshalb möchte ich das in mit einer Combobox anbieten.
In der Beigelegten Datei habe ich das Userform so geändert, dass dort sich bereits eine Combobox1 befindet. Die bisherige Textbox habe ich unter die Commandbutten verschoben. Diese möchte ich nach Umsetzung löschen.
Hier die Datei:
https://www.herber.de/bbs/user/93816.xlsm
Option Explicit
'Neuer Eintrag Schaltfläche Ereignisroutine
Private Sub CommandButton1_Click()
Dim lZeile As Long
lZeile = 3
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle3.Cells(lZeile, 1).Value)) ""
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
Tabelle3.Cells(lZeile, 1) = CStr("Neuer Eintrag Zeile " & lZeile)
ListBox1.AddItem CStr("Neuer Eintrag Zeile " & lZeile)
ListBox1.ListIndex = ListBox1.ListCount - 1
End Sub
'Löschen Schaltfläche Ereignisroutine
Private Sub CommandButton2_Click()
Dim lZeile As Long
'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet
If ListBox1.ListIndex = -1 Then Exit Sub
'Zum Löschen benötigen wir die Zeilennummer des ausgewählten Datensatzes
lZeile = 3 'Start in Zeile 5, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle3.Cells(lZeile, 1).Value)) ""
'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen
If ListBox1.Text = Trim(CStr(Tabelle3.Cells(lZeile, 1).Value)) Then
'Eintrag gefunden, die ganze Zeile wird nun gelöscht
Tabelle3.Rows(CStr(lZeile & ":" & lZeile)).Delete
Range("A3:J100").Select
ActiveWorkbook.Worksheets("MitarbeiterDB").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("MitarbeiterDB").Sort.SortFields.Add Key:=Range( _
"A3"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("MitarbeiterDB").Sort
.SetRange Range("A3:J100")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Die ListBox muss nun neu geladen werden!
Call UserForm_Initialize
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
End If
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End Sub
'Speichern Schaltfläche Ereignisroutine
Private Sub CommandButton3_Click()
Dim lZeile As Long
'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet
If ListBox1.ListIndex = -1 Then Exit Sub
'Wir müssen prüfen, ob die ID Spalte auch gefüllt ist!!
If Trim(CStr(TextBox1.Text)) = "" Then
'Meldung ausgeben
MsgBox "Sie müssen mindestens einen Namen eingeben!", vbCritical + vbOKOnly, "FEHLER!" _
'Abbrechen der Speicherroutine
Exit Sub
End If
'Ausbauoption: Prüfen, ob die ID in Tabelle1 Spalte 1 schon vorhanden ist!
'Zum Speichern benötigen wir die Zeilennummer des ausgewählten Datensatzes
lZeile = 3 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle3.Cells(lZeile, 1).Value)) ""
'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen
If ListBox1.Text = Trim(CStr(Tabelle3.Cells(lZeile, 1).Value)) Then
'Eintrag gefunden, TextBoxen in die Zellen schreiben
Tabelle3.Cells(lZeile, 1).Value = Trim(CStr(TextBox1.Text))
Tabelle3.Cells(lZeile, 2).Value = TextBox4.Text
Tabelle3.Cells(lZeile, 3).Value = TextBox3.Text
If Me.CheckBox1 = True Then
Tabelle3.Cells(lZeile, 4).Value = "Ja"
Else: Tabelle3.Cells(lZeile, 4).Value = ""
End If
If Me.CheckBox2 = True Then
Tabelle3.Cells(lZeile, 5).Value = "Ja"
Else: Tabelle3.Cells(lZeile, 5).Value = ""
End If
If Me.CheckBox3 = True Then
Tabelle3.Cells(lZeile, 6).Value = "Ja"
Else: Tabelle3.Cells(lZeile, 6).Value = ""
End If
If Me.CheckBox4 = True Then
Tabelle3.Cells(lZeile, 7).Value = "Ja"
Else: Tabelle3.Cells(lZeile, 7).Value = ""
End If
If Me.CheckBox5 = True Then
Tabelle3.Cells(lZeile, 8).Value = "Ja"
Else: Tabelle3.Cells(lZeile, 8).Value = ""
End If
If Me.CheckBox6 = True Then
Tabelle3.Cells(lZeile, 9).Value = "Ja"
Else: Tabelle3.Cells(lZeile, 9).Value = ""
End If
Range("A3:J100").Select
ActiveWorkbook.Worksheets("MitarbeiterDB").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("MitarbeiterDB").Sort.SortFields.Add Key:=Range( _
"A3"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("MitarbeiterDB").Sort
.SetRange Range("A3:J100")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Die ListBox muss nun neu geladen werden
'allerdings nur, wenn sich der Name (ID) geändert hat
If ListBox1.Text Trim(CStr(TextBox1.Text)) Then
Call UserForm_Initialize
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End If
Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
End If
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End Sub
'Beenden Schaltfläche Ereignisroutine
Private Sub CommandButton4_Click()
Unload Me
End Sub
'Klick auf die ListBox Ereignisroutine
Private Sub ListBox1_Click()
Dim lZeile As Long
Dim i As Variant
'Wenn der Benutzer einen Namen anklickt, suchen wir
'diesen in der Tabelle1 heraus und tragen die Daten
'in die TextBoxen ein.
'Wir löschen standardmäßig alle bisherigen TextBoxen-Inhalte
TextBox1 = ""
TextBox3 = ""
TextBox4 = ""
'Nur wenn ein Eintrag selektiert/markiert ist
If ListBox1.ListIndex >= 0 Then
lZeile = 3 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle3.Cells(lZeile, 1).Value)) ""
'Wenn wir den Namen aus der ListBox1 in der Tabelle1 Spalte 1
'gefunden haben, übertragen wir die anderen Spalteninhalte
'in die TextBoxen!
If ListBox1.Text = Trim(CStr(Tabelle3.Cells(lZeile, 1).Value)) Then
'TextBoxen füllen
TextBox1 = Trim(CStr(Tabelle3.Cells(lZeile, 1).Value))
TextBox4 = Tabelle3.Cells(lZeile, 2).Value
TextBox3 = Tabelle3.Cells(lZeile, 3).Value
If Tabelle3.Cells(lZeile, 4).Value = "Ja" Then
Me.CheckBox1 = Tabelle3.Cells(lZeile, 4).Value
Me.CheckBox1 = True
Else: Me.CheckBox1 = False
End If
If Tabelle3.Cells(lZeile, 5).Value = "Ja" Then
Me.CheckBox2 = Tabelle3.Cells(lZeile, 5).Value
Me.CheckBox2 = True
Else: Me.CheckBox2 = False
End If
If Tabelle3.Cells(lZeile, 6).Value = "Ja" Then
Me.CheckBox3 = Tabelle3.Cells(lZeile, 6).Value
Me.CheckBox3 = True
Else: Me.CheckBox3 = False
End If
If Tabelle3.Cells(lZeile, 7).Value = "Ja" Then
Me.CheckBox4 = Tabelle3.Cells(lZeile, 7).Value
Me.CheckBox4 = True
Else: Me.CheckBox4 = False
End If
If Tabelle3.Cells(lZeile, 8).Value = "Ja" Then
Me.CheckBox5 = Tabelle3.Cells(lZeile, 8).Value
Me.CheckBox5 = True
Else: Me.CheckBox5 = False
If Tabelle3.Cells(lZeile, 9).Value = "Ja" Then
Me.CheckBox6 = Tabelle3.Cells(lZeile, 9).Value
Me.CheckBox6 = True
Else: Me.CheckBox6 = False
End If
End If
Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist
End If
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End If
End Sub
Private Sub UserForm_Activate()
'Wenn die Eingabemaske angezeigt wird, markieren wir den ersten Namen
'jedoch nur, wenn auch Einträge in der Liste stehen
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End Sub
'Startroutine, wird ausgeführt bevor die Eingabemaske angezeigt wird
Private Sub UserForm_Initialize()
Dim lZeile As Long
'Alle TextBoxen leer machen
TextBox1 = ""
TextBox3 = ""
TextBox4 = ""
'In dieser Routine laden wir alle vorhandenen
'Einträge in die ListBox1
ListBox1.Clear 'Zuerst einmal die Liste leeren
lZeile = 3 'Start in Zeile 2, Zeile 1 sind ja die Überschriften
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle3.Cells(lZeile, 1).Value)) ""
'Aktuelle Zeile in die ListBox eintragen
ListBox1.AddItem Trim(CStr(Tabelle3.Cells(lZeile, 1).Value))
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End Sub