VBA - Wert wird nicht in die Datenbank übernommen
11.05.2017 15:47:38
Glanck
Es wird im vorab eine Userform geöffnet. Die Userform hat eine Textbox diverse Button sowie 2 Listboxen und 2 Checkboxen.
Die Checkbox gibt vor wo in der Datenbank der Wert hinterlegt werden soll und in welcher Listbox er ausgegeben werden soll.
Dies klappt bei der Anwahl von Checkbox 1 und anschließenden Speichern aber nicht bei der Anwahl der Checkbox 2.
'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 And ListBox2.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
If CheckBox1.Value = True Then
lZeile = 2 '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(Tabelle1.Cells(lZeile, 1).Value)) ""
'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen
If ListBox1.Text = Trim(CStr(Tabelle1.Cells(lZeile, 1).Value)) Then
'Eintrag gefunden, TextBoxen in die Zellen schreiben
Tabelle1.Cells(lZeile, 1).Value = Trim(CStr(TextBox1.Text))
'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 If
If CheckBox2.Value = True Then
lZeile = 2 '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(Tabelle1.Cells(lZeile, 3).Value)) ""
'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen
If ListBox2.Text = Trim(CStr(Tabelle1.Cells(lZeile, 3).Value)) Then
'Eintrag gefunden, TextBoxen in die Zellen schreiben
Tabelle1.Cells(lZeile, 3).Value = Trim(CStr(TextBox1.Text))
'Die ListBox muss nun neu geladen werden
'allerdings nur, wenn sich der Name (ID) geändert hat
If ListBox2.Text Trim(CStr(TextBox1.Text)) Then
Call UserForm_Initialize
If ListBox2.ListCount > 0 Then ListBox2.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 If
End Sub