Auslesen Textbox

Sub cmdÄnderungenSpeicherW_Click() Dim lZeile As Long 'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet (Übernommen) If ListW.ListIndex = -1 Then Exit Sub 'Wir müssen prüfen, ob die Namen Spalte auch gefüllt ist!! If Trim(CStr(txtNameW.Text)) = "" Then 'Meldung ausgeben MsgBox "Du musst mindestens einen Namen eingeben!", vbCritical + vbOKOnly, "FEHLER!" 'Abbrechen der Speicherroutine Exit Sub End If If MsgBox("Möchtest du die Änderungen wirklich übernehmen?", vbYesNo) = vbNo Then Unload Me FormularLeihWerks.Show End If 'Ausbauoption: Prüfen, ob der Name in Tabelle7 Spalte 1 schon vorhanden ist! 'Zum Speichern benötigen wir die Zeilennummer des ausgewählten Datensatzes lZeile = 3 'Start in Zeile 3, Zeile 1 und 2 sind ja die Überschriften 'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht Do While Trim(CStr(Tabelle7.Cells(lZeile, 1).Value)) "" 'Datensatz Name Spalte mit selektiertem Eintrag der ListBox vergleichen If ListW.Text = Trim(CStr(Tabelle7.Cells(lZeile, 1).Value)) Then 'Eintrag gefunden, TextBoxen in die Zellen schreiben Tabelle7.Cells(lZeile, 1).Value = Trim(CStr(txtNameW.Text)) Tabelle7.Cells(lZeile, 2).Value = txtVornameW.Text Tabelle7.Cells(lZeile, 15).Value = txtVertragsartW.Text Tabelle7.Cells(lZeile, 3).Value = txtAbteilungW.Text Tabelle7.Cells(lZeile, 5).Value = CDate(txtEintrittW.Value) Tabelle7.Cells(lZeile, 16).Value = txtEntlohnungW.Value Tabelle7.Cells(lZeile, 7).Value = CDate(txt1BefristungW.Value) Tabelle7.Cells(lZeile, 8).Value = CDate(txt2BefristungW.Value) Tabelle7.Cells(lZeile, 18).Value = txtKstW.Value 'Die ListBox muss nun neu geladen werden 'allerdings nur, wenn sich der Name geändert hat If ListW.Text Trim(CStr(txtNameW.Text)) Then Call UserForm_Initialize If ListW.ListCount > 0 Then ListW.ListIndex = 0 End If Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist End If lZeile = lZeile + 1 'Nächste Zeile bearbeiten Loop Unload Me FormularLeihWerks.Show End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub cmdÄnderungenSpeicherW_Click() Dim lZeile As Long 'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet (Übernommen) If ListW.ListIndex = -1 Then Exit Sub 'Wir müssen prüfen, ob die Namen Spalte auch gefüllt ist!! If Trim(CStr(txtNameW.Text)) = "" Then 'Meldung ausgeben MsgBox "Du musst mindestens einen Namen eingeben!", vbCritical + vbOKOnly, "FEHLER!" 'Abbrechen der Speicherroutine Exit Sub End If If MsgBox("Möchtest du die Änderungen wirklich übernehmen?", vbYesNo) = vbNo Then Unload Me FormularLeihWerks.Show End If 'Ausbauoption: Prüfen, ob der Name in Tabelle7 Spalte 1 schon vorhanden ist! 'Zum Speichern benötigen wir die Zeilennummer des ausgewählten Datensatzes lZeile = 3 'Start in Zeile 3, Zeile 1 und 2 sind ja die Überschriften 'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht Do While Trim(CStr(Tabelle7.Cells(lZeile, 1).Value)) "" 'Datensatz Name Spalte mit selektiertem Eintrag der ListBox vergleichen If ListW.Text = Trim(CStr(Tabelle7.Cells(lZeile, 1).Value)) Then If IsDate(txt2BefristungW.Value) Then Tabelle7.Cells(lZeile, 8).Value = CDate( _ txt2BefristungW.Value) 'Eintrag gefunden, TextBoxen in die Zellen schreiben Tabelle7.Cells(lZeile, 1).Value = Trim(CStr(txtNameW.Text)) Tabelle7.Cells(lZeile, 2).Value = txtVornameW.Text Tabelle7.Cells(lZeile, 15).Value = txtVertragsartW.Text Tabelle7.Cells(lZeile, 3).Value = txtAbteilungW.Text Tabelle7.Cells(lZeile, 5).Value = CDate(txtEintrittW.Value) Tabelle7.Cells(lZeile, 16).Value = txtEntlohnungW.Value Tabelle7.Cells(lZeile, 7).Value = CDate(txt1BefristungW.Value) 'Tabelle7.Cells(lZeile, 8).Value = CDate(txt2BefristungW.Value) Tabelle7.Cells(lZeile, 18).Value = txtKstW.Value 'Die ListBox muss nun neu geladen werden 'allerdings nur, wenn sich der Name geändert hat If ListW.Text Trim(CStr(txtNameW.Text)) Then Call UserForm_Initialize If ListW.ListCount > 0 Then ListW.ListIndex = 0 End If Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist End If lZeile = lZeile + 1 'Nächste Zeile bearbeiten Loop Unload Me FormularLeihWerks.Show End Sub

Hallo,
so war das gemeint:

Sub cmdÄnderungenSpeicherW_Click()
    Dim lZeile As Long

    'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet (Übernommen)
    If ListW.ListIndex = -1 Then Exit Sub

    'Wir müssen prüfen, ob die Namen Spalte auch gefüllt ist!!
    If Trim(CStr(txtNameW.Text)) = "" Then
        'Meldung ausgeben
        MsgBox "Du musst mindestens einen Namen eingeben!", vbCritical + vbOKOnly, "FEHLER!"
        'Abbrechen der Speicherroutine
        Exit Sub
    End If
    If MsgBox("Möchtest du die Änderungen wirklich übernehmen?", vbYesNo) = vbNo Then
        Unload Me
        FormularLeihWerks.Show
    End If
    'Ausbauoption: Prüfen, ob der Name in Tabelle7 Spalte 1 schon vorhanden ist!

    'Zum Speichern benötigen wir die Zeilennummer des ausgewählten Datensatzes
    lZeile = 3 'Start in Zeile 3, Zeile 1 und 2 sind ja die Überschriften
    'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
    Do While Trim(CStr(Tabelle7.Cells(lZeile, 1).Value)) <> ""

        'Datensatz Name Spalte mit selektiertem Eintrag der ListBox vergleichen
        If ListW.Text = Trim(CStr(Tabelle7.Cells(lZeile, 1).Value)) Then

            'Eintrag gefunden, TextBoxen in die Zellen schreiben
            Tabelle7.Cells(lZeile, 1).Value = Trim(CStr(txtNameW.Text))
            Tabelle7.Cells(lZeile, 2).Value = txtVornameW.Text
            Tabelle7.Cells(lZeile, 15).Value = txtVertragsartW.Text
            Tabelle7.Cells(lZeile, 3).Value = txtAbteilungW.Text
            If IsDate(txtEintrittW.Value) Then Tabelle7.Cells(lZeile, 5).Value = CDate(txtEintrittW.Value)
            Tabelle7.Cells(lZeile, 16).Value = txtEntlohnungW.Value
            If IsDate(txt1BefristungW.Value) Then Tabelle7.Cells(lZeile, 7).Value = CDate(txt1BefristungW.Value)
            If IsDate(txt2BefristungW.Value) Then Tabelle7.Cells(lZeile, 8).Value = CDate(txt2BefristungW.Value)
            Tabelle7.Cells(lZeile, 18).Value = txtKstW.Value

            'Die ListBox muss nun neu geladen werden
            'allerdings nur, wenn sich der Name geändert hat
            If ListW.Text <> Trim(CStr(txtNameW.Text)) Then
                Call UserForm_Initialize
                If ListW.ListCount > 0 Then ListW.ListIndex = 0
            End If

            Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist

        End If

        lZeile = lZeile + 1 'Nächste Zeile bearbeiten
    Loop
    Unload Me
    FormularLeihWerks.Show

End Sub

Gruß
Nepumuk

So, nach langen suchen im Netz habe ich die Lösung!
In die Userform den Code unten eingeben und alle Datumsformat Probleme sind gelöst!
Vielen dank an den Autor dieses Beitrages.
Gruß Michael
Datumseingabe in Access und VBA in Access
Verfasst von Gast am 24. September 2015 - 18:48.
In dem Wortlaut steht das VBA immer die US Schreibweise verwendet
Irrtum
Datefelder können in der Form 11-12-2015 eingegeben werden
Das Problem jedoch, das bei Eingabe von 12.14.2015 in ein Feld vom Format Date in Access er daraus 14.12.macht
Die Tag Monat und Jahr Abfrage liefert bei 11.12.2015 ein 11,12,2015
Die Tag Monat und Jahr Abfrage liefert bei 12.14.2015 ein 14,12,2015
Auch der isdate arbeitet inkorrekt und das ganze lässt sich durch eine Funktion die vor die Feldaktualisierung eingebracht wird nicht abfangen.
Es hilft nur eine Verwendung eines Eingabefeldes vom Typ String dessen Wert man zuerst per VBA auf Gültigkeit prüft und danach diesen String in das Datumsfeld des Datensatzes einbringt.
Dies geht in Access ja durch das unsichtbar machen des Datensatzfeldes und das sichtbar machen des Eingabefeldes. Dabei auf Aktivierung und Sperung achten.
Bsp. Stellen zwischen 1.tem und 2.ten Punkt auf Gültigkeit 1-12 testen.
Ich habe eine Function geschrieben die gleichzeitig die Eingaben im Format 1.1.2015, 1-12-2015 oder 2/4/2015 erlaubt

Private Function Datumtest(ByVal Datumstring As String) As Boolean
Dim Zaehler As Integer
Dim Pospunkt(1) As Integer
Dim Posstrich(1) As Integer
Dim Posbindestrich(1) As Integer
Zaehler = 0
If Len(Datumstring) > 10 Or Len(Datumstring)  1 And Posbindestrich(0) = 0 Then
Posbindestrich(0) = Zaehler
ElseIf Zaehler > 3 And Posbindestrich(1) = 0 Then
Posbindestrich(1) = Zaehler
Else
'Fehler da mehr als 2 Striche
MsgBox "Datum inkorrekt. Eingabe wie dd/mm/yyyy oder d-mm-yy oder d.mm.yyyy erforderlich !"
Datumtest = False
Exit Function
End If
Case 46 'Punkt
If Zaehler > 1 And Pospunkt(0) = 0 Then
Pospunkt(0) = Zaehler
ElseIf Zaehler > 3 And Pospunkt(1) = 0 Then
Pospunkt(1) = Zaehler
Else
'Fehler da mehr als 2 Punkte
MsgBox "Datum inkorrekt. Eingabe wie dd/mm/yyyy oder d-mm-yy oder d.mm.yyyy erforderlich !"
Datumtest = False
Exit Function
End If
Case 47 '/ Strich
If Zaehler > 1 And Posstrich(0) = 0 Then
Posstrich(0) = Zaehler
ElseIf Zaehler > 3 And Posstrich(1) = 0 Then
Posstrich(1) = Zaehler
Else
'Fehler da mehr als 2 Schrägstriche
MsgBox "Datum inkorrekt. Eingabe wie dd/mm/yyyy oder d-mm-yy oder d.mm.yyyy erforderlich !"
Datumtest = False
Exit Function
End If
Case 48 To 57
'Zahl zwischen 0 und 9
Case Else 'Kein korrektes Zeichen
MsgBox "Datum inkorrekt. Eingabe wie dd/mm/yyyy oder d/m/yy oder d.mm.yyyy erforderlich !"
Datumtest = False
Exit Function
End Select
Loop While Zaehler  0 Then
If Pospunkt(0)  0 Or Posstrich(0)  0 Or Posbindestrich(1) = 0 Or Posbindestrich(0) + 1 =  _
Posbindestrich(1) Then
MsgBox "Datum inkorrekt. Eingabe wie dd/mm/yyyy oder d/m/yy oder d.mm.yyyy erforderlich !"
Datumtest = False
Exit Function
Else
'Check ob Monatszahl >12
If Val(Mid$(Datumstring, Posbindestrich(0) + 1, Posbindestrich(1) - Posbindestrich(0) - 1)) >  _
12 Then
MsgBox "Datum inkorrekt. Eingabe wie dd/mm/yyyy oder d/m/yy oder d.mm.yyyy erforderlich !"
Datumtest = False
Exit Function
End If
End If
End If
If Pospunkt(0)  0 Then
If Posbindestrich(0)  0 Or Posstrich(0)  0 Or Pospunkt(1) = 0 Or Pospunkt(0) + 1 = Pospunkt( _
1) Then
MsgBox "Datum inkorrekt. Eingabe wie dd/mm/yyyy oder d/m/yy oder d.mm.yyyy erforderlich !"
Datumtest = False
Exit Function
Else
'Check ob Monatszahl >12
If Val(Mid$(Datumstring, Pospunkt(0) + 1, Pospunkt(1) - Pospunkt(0) - 1)) > 12 Then
MsgBox "Datum inkorrekt. Eingabe wie dd/mm/yyyy oder d/m/yy oder d.mm.yyyy erforderlich !"
Datumtest = False
Exit Function
End If
End If
End If
If Posstrich(0)  0 Then
If Posbindestrich(0)  0 Or Pospunkt(0)  0 Or Posstrich(1) = 0 Or Posstrich(0) + 1 =  _
Posstrich(1) Then
MsgBox "Datum inkorrekt. Eingabe wie dd/mm/yyyy oder d/m/yy oder d.mm.yyyy erforderlich !"
Datumtest = False
Exit Function
Else
'Check ob Monatszahl >12
If Val(Mid$(Datumstring, Posstrich(0) + 1, Posstrich(1) - Posstrich(0) - 1)) > 12 Then
MsgBox "Datum inkorrekt. Eingabe wie dd/mm/yyyy oder d/m/yy oder d.mm.yyyy erforderlich !"
Datumtest = False
Exit Function
End If
End If
End If
If IsDate(Datumstring) Then
'Fehler wenn Datumeingabe z.B 12.14.2015, dies da er im Datumsfeld Tag und Monat wechselt
'Fehler auch bei month(12.15.2015), Access zeigt 12
'Darum vorab Check ob Monat >12
Datumtest = True
Else
Datumtest = False
End If
End Function

Bye
Mike

Sub cmdÄnderungenSpeicherW_Click() Dim lZeile As Long 'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet (Übernommen) If ListW.ListIndex = -1 Then Exit Sub 'Wir müssen prüfen, ob die Namen Spalte auch gefüllt ist!! If Trim(CStr(txtNameW.Text)) = "" Then 'Meldung ausgeben MsgBox "Du musst mindestens einen Namen eingeben!", vbCritical + vbOKOnly, "FEHLER!" 'Abbrechen der Speicherroutine Exit Sub End If If MsgBox("Möchtest du die Änderungen wirklich übernehmen?", vbYesNo) = vbNo Then Unload Me FormularLeihWerks.Show End If 'Ausbauoption: Prüfen, ob der Name in Tabelle7 Spalte 1 schon vorhanden ist! 'Zum Speichern benötigen wir die Zeilennummer des ausgewählten Datensatzes lZeile = 3 'Start in Zeile 3, Zeile 1 und 2 sind ja die Überschriften 'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht Do While Trim(CStr(Tabelle7.Cells(lZeile, 1).Value)) "" 'Datensatz Name Spalte mit selektiertem Eintrag der ListBox vergleichen If ListW.Text = Trim(CStr(Tabelle7.Cells(lZeile, 1).Value)) Then 'Eintrag gefunden, TextBoxen in die Zellen schreiben Tabelle7.Cells(lZeile, 1).Value = Trim(CStr(txtNameW.Text)) Tabelle7.Cells(lZeile, 2).Value = txtVornameW.Text Tabelle7.Cells(lZeile, 15).Value = txtVertragsartW.Text Tabelle7.Cells(lZeile, 3).Value = txtAbteilungW.Text Tabelle7.Cells(lZeile, 16).Value = txtEntlohnungW.Value Tabelle7.Cells(lZeile, 18).Value = txtKstW.Value Select Case txtEintrittW Case (txtEintrittW.Value): Tabelle7.Cells(lZeile, 5).Value = (txtEintrittW.Value) Case (txtEintrittW.Value), "": Tabelle7.Cells(lZeile, 5).Value = "" End Select Select Case txt1BefristungW Case IsDate(txt1BefristungW.Value): Tabelle7.Cells(lZeile, 7).Value = CDate( _ txt1BefristungW.Value) Case (txt1BefristungW.Value), "": Tabelle7.Cells(lZeile, 7).Value = "" End Select Select Case txt2BefristungW Case IsDate(txt2BefristungW.Value): Tabelle7.Cells(lZeile, 8).Value = CDate( _ txt2BefristungW.Value) Case (txt2BefristungW.Value), "": Tabelle7.Cells(lZeile, 8).Value = "" End Select 'Die ListBox muss nun neu geladen werden 'allerdings nur, wenn sich der Name geändert hat If ListW.Text Trim(CStr(txtNameW.Text)) Then Call UserForm_Initialize If ListW.ListCount > 0 Then ListW.ListIndex = 0 End If Exit Do 'Vorzeitiges Ende, da der Datensatz schon gefunden ist End If lZeile = lZeile + 1 'Nächste Zeile bearbeiten Loop Unload Me FormularLeihWerks.Show End Sub

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Auslesen Textbox

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread