mit Datum aus TextBox rechnen
03.09.2017 11:55:00
Martin
ich bin schon seit einer Woche am probieren und suchen, habe aber noch nichts gefunden.
Ich möchte das ein Datum aus einer TextBox in eine Tabelle übergeben wird, mit dem man rechnen kann.
Ich habe es schon mit Afterupdate probiert und etlichen Formatieren, z.B. CDate, aber leider ist das Datum welches dann in der Tabelle steht nicht zum rechnen geeignet. Geht so etwas überhaupt.
Füge mal den Code bei, der auch funktioniert, eben nur nicht zum rechnen des Datum's.
Ich hoffe es hat jemand eine Idee.
Danke schon mal
Gruß Martin
Option Explicit
Option Compare Text
'Neuer Eintrag Schaltfläche Ereignisroutine
Private Sub Cmd_neu_Click()
Dim lZeile As Long
'Wenn der Benutzer einen neuen Eintrag erzeugen möchte,
'erstellen wir einen neuen Eintrag in der ListBox und markieren
'diesen, damit der Benutzer die Daten eintragen kann
lZeile = 5 'Start in Zeile 5, Zeile 4 sind ja die überschriftrn
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle18.Cells(lZeile, 6).Value)) ""
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
'Nach Durchlauf dieser Schleife steht lZeile in der ersten leeren Zeile von Tabelle18
'Neuen Eintrag in die Tabelle18 schreiben, Spalte ID muss gefüllt sein, damit
'unsere Routinen die Zeile wiederfinden!
Tabelle18.Cells(lZeile, 6) = CStr("Mitglied Nr " & lZeile)
'Und neuen Eintrag in die UserForm eintragen
ListBox1.AddItem CStr("Mitglied Nr " & lZeile)
TextBox7.SetFocus
'Den neuen Eintrag markieren mit Hilfe des ListIndexes
ListBox1.ListIndex = ListBox1.ListCount - 1
'Durch das Click Ereignis der ListBox werden die Daten automatisch geladen
End Sub
'Löschen Schaltfläche Ereignisroutine
Private Sub Cmd_del_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 = 5 'Start in Zeile 5,
'Schleife solange etwas in der ersten Spalte in Tabelle 1 steht
Do While Trim(CStr(Tabelle18.Cells(lZeile, 6).Value)) ""
'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen
If ListBox1.Text = Trim(CStr(Tabelle18.Cells(lZeile, 6).Value)) Then
'Eintrag gefunden, die ganze Zeile wird nun gelöscht
Tabelle18.Rows(CStr(lZeile & ":" & lZeile)).Delete
'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 Cmd_save_Click()
Dim lZeile As Integer
'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 Tabelle18 Spalte 1 schon vorhanden ist!
'Zum Speichern benötigen wir die Zeilennummer des ausgewählten Datensatzes
lZeile = 5 'Start in Zeile 5, Zeile 4 sind ja die Überschriften
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle18.Cells(lZeile, 6).Value)) ""
'Datensatz ID Spalte mit selektiertem Eintrag der ListBox vergleichen
If ListBox1.Text = Trim(CStr(Tabelle18.Cells(lZeile, 6).Value)) Then
'Eintrag gefunden, TextBoxen in die Zellen schreiben
Tabelle18.Cells(lZeile, 8).Value = Trim(CStr(TextBox1.Text)) 'Name
Tabelle18.Cells(lZeile, 9).Value = TextBox2.Text ' _
Vorname
Tabelle18.Cells(lZeile, 10).Value = TextBox3.Text ' _
Strasse
Tabelle18.Cells(lZeile, 11).Value = TextBox4.Text 'Plz/ _
_
_
ort
Tabelle18.Cells(lZeile, 12).Value = TextBox5.Text ' _
Telefon
Tabelle18.Cells(lZeile, 13).Value = TextBox6.Text ' _
Geburtsdatum
Tabelle18.Cells(lZeile, 6).Value = TextBox7.Text ' _
Mitglieds Nr
Tabelle18.Cells(lZeile, 15).Value = ComboBox1.Text ' _
Instrument
Tabelle18.Cells(lZeile, 16).Value = TextBox9.Text 'SZ _
seit
Tabelle18.Cells(lZeile, 17).Value = TextBox10.Text 'SZ _
bis
Tabelle18.Cells(lZeile, 18).Value = TextBox8.Text ' _
Bemerkungen
Tabelle18.Cells(lZeile, 21).Value = ComboBox2.Text 'aktiv _
_
_
ja / nein
'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 Cmd_exit_Click()
Application.ScreenUpdating = False
Sheets("Spielleute").Select
Call Cmdaktive_Click
Unload Me
Sheets("Spielleute").Select
Range("C2").Select
Application.ScreenUpdating = True
End Sub
'Klick auf die ListBox Ereignisroutine
Private Sub ListBox1_Click()
Dim lZeile As Long
'Wenn der Benutzer einen Namen anklickt, suchen wir
'diesen in der Tabelle18 heraus und tragen die Daten
'in die TextBoxen ein.
'Wir löschen standardmäßig alle bisherigen TextBoxen-Inhalte
TextBox1 = "" 'Name
TextBox2 = "" 'Vorname
TextBox3 = "" 'Strasse
TextBox4 = "" 'Plz/Ort
TextBox5 = "" 'Telefon
TextBox6 = "" 'Geburtsdatum
TextBox7 = "" 'Mitglieds Nr.
TextBox8 = "" 'Bemerkungen
TextBox9 = "" 'SZ seit
TextBox10 = "" 'SZ bis
ComboBox1 = "" 'Instrument
ComboBox2 = "" 'Aktiv ja/nein
'Nur wenn ein Eintrag selektiert/markiert ist
If ListBox1.ListIndex >= 0 Then
lZeile = 5 'Start in Zeile 5,
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle18.Cells(lZeile, 6).Value)) ""
'Wenn wir den Namen aus der ListBox1 in der Tabelle18 Spalte 1
'gefunden haben, übertragen wir die anderen Spalteninhalte
'in die TextBoxen!
If ListBox1.Text = Trim(CStr(Tabelle18.Cells(lZeile, 6).Value)) Then
'TextBoxen füllen
TextBox7 = Trim(CStr(Tabelle18.Cells(lZeile, 6).Value)) 'Mitglied Nr
TextBox1 = Tabelle18.Cells(lZeile, 8).Value 'Name
TextBox2 = Tabelle18.Cells(lZeile, 9).Value 'Vorname
TextBox3 = Tabelle18.Cells(lZeile, 10).Value 'Strasse
TextBox4 = Tabelle18.Cells(lZeile, 11).Value 'Plz/ort
TextBox5 = Tabelle18.Cells(lZeile, 12).Value 'Telefon
TextBox6 = Tabelle18.Cells(lZeile, 13).Value 'Geburtsdatum
ComboBox1.Text = Tabelle18.Cells(lZeile, 15).Value 'Instrument
TextBox8 = Tabelle18.Cells(lZeile, 18).Value 'Bemerkungen
TextBox9 = Tabelle18.Cells(lZeile, 16).Value 'SZ seit
TextBox10 = Tabelle18.Cells(lZeile, 17).Value 'SZ bis
ComboBox2.Text = Tabelle18.Cells(lZeile, 21).Value 'aktiv ja / _
nein
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()
'Spalten in Liste = 3 Überschriften aus
With UserForm1
.ListBox1.ColumnCount = 3
.ListBox1.ColumnWidths = "150;210;210"
.ListBox1.ColumnHeads = False
End With
'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
TextBox7.SetFocus
With Me.ComboBox1
.AddItem "Flöte"
.AddItem "Lyra"
.AddItem "Schlagzeug"
.AddItem "Trommel"
.AddItem "Sonstige"
'.ListIndex = 0 'Vorbelegung "Flöte" bei Formularstart
End With
With Me.ComboBox2
.AddItem "ja"
.AddItem "nein"
.AddItem ""
End With
End Sub
'Startroutine, wird ausgeführt bevor die Eingabemaske angezeigt wird
Private Sub UserForm_Initialize()
Me.Zoom = GetSystemMetrics(SM_CXSCREEN) / X_RESOLUTION * 100
Dim lZeile As Long
'Alle TextBoxen leer machen
TextBox1 = "" 'Name
TextBox2 = "" 'Vorname
TextBox3 = "" 'Strasse
TextBox4 = "" 'Plz/Ort
TextBox5 = "" 'Telefon
TextBox6 = "" 'Geburtsdatum
TextBox7 = "" 'Mitglieds Nr.
TextBox8 = "" 'Bemerkungen
TextBox9 = "" 'SZ seit
TextBox10 = "" 'SZ bis
ComboBox1 = "" 'Instrument
ComboBox2 = "" 'Aktiv ja/nein
'In dieser Routine laden wir alle vorhandenen
'Einträge in die ListBox1
ListBox1.Clear 'Zuerst einmal die Liste leeren
lZeile = 5 'Start in Zeile 5,
'Schleife solange etwas in der ersten Spalte in Tabelle 1 drin steht
Do While Trim(CStr(Tabelle18.Cells(lZeile, 6).Value)) ""
'Aktuelle Zeile in die ListBox eintragen
ListBox1.AddItem Trim(CStr(Tabelle18.Cells(lZeile, 6).Value))
ListBox1.List(ListBox1.ListCount - 1, 1) = Trim(CStr(Tabelle18.Cells(lZeile, 8).Value))
ListBox1.List(ListBox1.ListCount - 1, 2) = Trim(CStr(Tabelle18.Cells(lZeile, 9).Value))
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End Sub
'
Private Sub TextBox10_AfterUpdate()
'TextBox10 = Format(TextBox10, "DD.MM.YYYY")
'End Sub
Private Sub UserForm_Zoom(Percent As Integer)
Me.Width = Me.Width * Percent / 100
Me.Height = Me.Height * Percent / 100
End Sub