AW: Daten verschieben nach Eintrag in Box
12.11.2021 08:39:22
Stefan
Hallo Kai,
ohne mir jetzt den Rest von dem Code anzusehen, außerdem natürlich ungetestet.
Private Sub CommandButton3_Click() 'Funktion wird aufgerufen, wenn CommandButton3 (Speichern) gedrückt wird
Dim lZeile As Long
Dim Datumalt As Date
Dim Datumneu As Date
Dim i As Integer
Dim lrange As Range
'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet
If ListBox1.ListIndex = -1 Then Exit Sub
'****Fehlermeldungen, welche erscheinen, wenn in der Eingabemaske nicht alle nötigen Angaben gemacht wurden****************************************************************
'Anrede
If OptionButton5 = False And OptionButton6 = False Then 'Prüfen, ob Anrede ausgefüllt wurde
'Falls nicht ausgefüllt, Meldung ausgeben und speichern abbrechen
MsgBox "Sie müssen eine passende Anrede auswählen!", vbCritical + vbOKOnly, "FEHLER!"
Exit Sub
End If
'Name
If Trim(CStr(TextBox1.Text)) = "" Then 'Prüfen, ob Name ausgefüllt wurde
'Falls nicht ausgefüllt, Meldung ausgeben und speichern abbrechen
MsgBox "Sie müssen den Namen!", vbCritical + vbOKOnly, "FEHLER!"
Exit Sub
End If
'Vorname
If Trim(CStr(TextBox2.Text)) = "" Then 'Prüfen, ob Vorname ausgefüllt wurde
'Falls nicht ausgefüllt, Meldung ausgeben und speichern abbrechen
MsgBox "Sie müssen den Vornamen!", vbCritical + vbOKOnly, "FEHLER!"
Exit Sub
End If
'Abteilung
If Trim(CStr(TextBox3.Text)) = "" Then 'Prüfen, ob Abteilung ausgefüllt wurde
'Falls nicht ausgefüllt, Meldung ausgeben und speichern abbrechen
MsgBox "Sie müssen den Namen der Abteilung eingeben!", vbCritical + vbOKOnly, "FEHLER!"
Exit Sub
End If
'Personal-Nr.
'If Trim(CStr(TextBox4.Text)) = "" Then 'Prüfen, ob Personal-Nr. ausgefüllt wurde
'Falls nicht ausgefüllt, Meldung ausgeben und speichern abbrechen
'MsgBox "Sie müssen die Personal-Nr. eingeben!", vbCritical + vbOKOnly, "FEHLER!"
'Exit Sub
'End If
'Kürzel
If Trim(CStr(TextBox5.Text)) = "" Then 'Prüfen, ob Kürzel ausgefüllt wurde
'Falls nicht ausgefüllt, Meldung ausgeben und speichern abbrechen
MsgBox "Sie müssen das Kürzel eingeben!", vbCritical + vbOKOnly, "FEHLER!"
Exit Sub
End If
'Eintritt
If Trim(CStr(TextBox6.Text)) = "" Then 'Prüfen, ob Eintritt ausgefüllt wurde
'Falls nicht ausgefüllt, Meldung ausgeben und speichern abbrechen
MsgBox "Sie müssen den Eintritt eingeben!", vbCritical + vbOKOnly, "FEHLER!"
Exit Sub
End If
'Austritt
'If Trim(CStr(TextBox6.Text)) = "" Then 'Prüfen, ob Austritt ausgefüllt wurde
'Falls nicht ausgefüllt, Meldung ausgeben und speichern abbrechen
'MsgBox "Sie müssen den Austritt eingeben!", vbCritical + vbOKOnly, "FEHLER!"
'Exit Sub
'End If
If TextBox9 = "" Then
With Tabelle1
lZeile = ListBox1.ListIndex 'lZeile den mit dem ListIndex überschreiben
If OptionButton5.Value = True Then 'Falls Optionbutton5 (Anrede = Herr) angekreuzt wird
.Cells(lZeile + 2, 1) = "Herr" '"Herr" als Anrede in Tabelle eingetragen
ElseIf OptionButton6.Value = True Then 'Falls Optionbutton6 (Anrede = Frau) angekreuzt wird
.Cells(lZeile + 2, 1) = "Frau" 'wird "Frau" als Anrede in Tabelle eingetragen
End If
'Eintrag gefunden, TextBoxen in die Zellen schreiben
.Cells(lZeile + 2, 2).Value = Trim(CStr(TextBox1.Text))
.Cells(lZeile + 2, 3).Value = TextBox2.Text
.Cells(lZeile + 2, 4).Value = TextBox3.Text
.Cells(lZeile + 2, 5).Value = TextBox4.Text
.Cells(lZeile + 2, 6).Value = TextBox5.Text
.Cells(lZeile + 2, 7).Value = TextBox6.Text
.Cells(lZeile + 2, 8).Value = TextBox9.Text
.Cells(lZeile + 2, 9).Value = Date 'DateAdd("d", 0, TextBox9.Text) 'Datum aufaddiert in Form: "d" für Tag, "30" Anzahl der Tage, Value)
End With
ElseIf TextBox9 "" Then
With Tabelle2
lZeile = ListBox1.ListIndex 'lZeile den mit dem ListIndex überschreiben
If OptionButton5.Value = True Then 'Falls Optionbutton5 (Anrede = Herr) angekreuzt wird
.Cells(lZeile + 2, 1) = "Herr" '"Herr" als Anrede in Tabelle eingetragen
ElseIf OptionButton6.Value = True Then 'Falls Optionbutton6 (Anrede = Frau) angekreuzt wird
.Cells(lZeile + 2, 1) = "Frau" 'wird "Frau" als Anrede in Tabelle eingetragen
End If
'Eintrag gefunden, TextBoxen in die Zellen schreiben
.Cells(lZeile + 2, 2).Value = Trim(CStr(TextBox1.Text))
.Cells(lZeile + 2, 3).Value = TextBox2.Text
.Cells(lZeile + 2, 4).Value = TextBox3.Text
.Cells(lZeile + 2, 5).Value = TextBox4.Text
.Cells(lZeile + 2, 6).Value = TextBox5.Text
.Cells(lZeile + 2, 7).Value = TextBox6.Text
.Cells(lZeile + 2, 8).Value = TextBox9.Text
.Cells(lZeile + 2, 9).Value = Date 'DateAdd("d", 0, TextBox9.Text) 'Datum aufaddiert in Form: "d" für Tag, "30" Anzahl der Tage, Value)
End With
Set lrange = Tabelle1.Range("F2:F300").Find(TextBox5.Text) 'Prüfen ob eingetragenes Namenskürzel vorhanden
If Not lrange Is Nothing Then 'Wenn Kürzel vorhanden
i = lrange.Row 'Zeile finden, in welcher das Namenskürzel steht
Tabelle1.Rows(i).Delete 'Gefundene Zeile löschen
End If
End With
Call UserForm_Initialize 'Funktion "Useform_Initialize" aufrufen
If ListBox1.ListIndex = -1 Then Exit Sub 'Falls kein Eintrag markiert, Funktion beenden
ListBox1.ListIndex = lZeile 'Nach Aktualisierung wird Makierung zurückgesetzt, deswegen alte Markierung wiederherstellen
End Sub
Gruß
Stefan