Textbox gibt Datum als Text aus!!
20.09.2015 21:21:04
Andy
habe ein Problem mit der Textbox1, wenn ich ein Datum über Useform eingebe in der Textbox1 gibt er mir das als Text in der Zelle aus.
Ich versuche schon die ganze Zeit das hinzubekommen, aber bekomme das nicht hin.
Vielleicht kann von euch jemand darüber schauen und mir eine Hilfestellung geben.
Wenn es geht würde ich gerne beim neuen Datensatz gleich das aktuelle Datum in TexBox1 eintragen.
der komplette Code hier!
Danke im voraus!!
Private Sub CommandButton1_Click()
Dim lZeile As Long
lZeile = 4 'Start in Zeile 6, Zeile 1 sind die Überschriften
Do While Trim(Tabelle2.Cells(lZeile, 1).Value) ""
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
Tabelle2
Tabelle2.Cells(lZeile, 1) = CDate(lZeile)
ListBox1.AddItem CDate(lZeile)
ListBox1.ListIndex = ListBox1.ListCount - 1
End Sub
'Löschen Schaltfläche Ereignisroutine
Private Sub CommandButton2_Click()
Dim lZeile As Long
If ListBox1.ListIndex = -1 Then Exit Sub
lZeile = 4 'Start in Zeile 2, Zeile 1 sind ja die Überschriftrn
Do While Trim(CDate(Tabelle2.Cells(lZeile, 1).Value)) ""
If ListBox1.Text = Trim(Tabelle2.Cells(lZeile, 1).Value) Then
Tabelle2.Rows(lZeile & ":" & lZeile).Delete
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
Private Sub CommandButton3_Click()
Dim lZeile As Long
Dim i As Integer
On Error GoTo ErrExit
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlManual
.DisplayAlerts = False
End With
If ListBox1.ListIndex > -1 And Trim(TextBox1.Text) "" Then
lZeile = 4
With Tabelle2
Do While Trim(.Cells(lZeile, 1).Value) ""
If ListBox1.Text = Trim(.Cells(lZeile, 1).Value) Then
.Rows(lZeile).Font.Bold = Day(CDate(TextBox1.Text)) = 1
If IsDate(TextBox1.Text) Then .Cells(lZeile, 1).Value = Trim(CDate(TextBox1.Text))
.Cells(lZeile, 1).Value = Format(TextBox1.Text, "DD.MM.YYYY")
If IsNumeric(TextBox2.Text) Then .Cells(lZeile, 2).Value = CDbl(TextBox2.Text)
TextBox3.Value = .Cells(lZeile, 2).Value - .Cells(lZeile - 1, 2).Value
If IsNumeric(TextBox3.Text) Then .Cells(lZeile, 3).Value = CDbl(TextBox3.Text)
.Cells(lZeile, 4).Value = Format(TextBox4.Text, "0 °C")
If IsNumeric(TextBox5.Text) Then .Cells(lZeile, 5).Value = CDbl(TextBox5.Text)
TextBox6.Value = .Cells(lZeile, 5).Value - .Cells(lZeile - 1, 5).Value
If IsNumeric(TextBox6.Text) Then .Cells(lZeile, 6).Value = CDbl(TextBox6.Text)
.Cells(lZeile, 7).Value = Format(TextBox7.Text, "0 °C")
If IsNumeric(TextBox8.Text) Then .Cells(lZeile, 8).Value = CDbl(TextBox8.Text)
TextBox9.Value = .Cells(lZeile, 8).Value - .Cells(lZeile - 1, 8).Value
If IsNumeric(TextBox9.Text) Then .Cells(lZeile, 9).Value = CDbl(TextBox9.Text)
.Cells(lZeile, 10).Value = Format(TextBox10.Text, "0 °C")
If IsNumeric(TextBox11.Text) Then .Cells(lZeile, 11).Value = CDbl(TextBox11.Text)
TextBox12.Value = .Cells(lZeile, 11).Value - .Cells(lZeile - 1, 11).Value
If IsNumeric(TextBox12.Text) Then .Cells(lZeile, 12).Value = CDbl(TextBox12.Text)
.Cells(lZeile, 13).Value = Format(TextBox13.Text, "0 °C")
If IsNumeric(TextBox14.Text) Then .Cells(lZeile, 14).Value = CDbl(TextBox14.Text)
TextBox15.Value = .Cells(lZeile, 14).Value - .Cells(lZeile - 1, 14).Value
If IsNumeric(TextBox15.Text) Then .Cells(lZeile, 15).Value = CDbl(TextBox15.Text)
.Cells(lZeile, 16).Value = Format(TextBox16.Text, "0 °C")
If IsNumeric(TextBox17.Text) Then .Cells(lZeile, 17).Value = CDbl(TextBox17.Text)
TextBox18.Value = .Cells(lZeile, 17).Value - .Cells(lZeile - 1, 17).Value
If IsNumeric(TextBox18.Text) Then .Cells(lZeile, 18).Value = CDbl(TextBox18.Text)
.Cells(lZeile, 19).Value = Format(TextBox19.Text, "0 °C")
If IsNumeric(TextBox20.Text) Then .Cells(lZeile, 20).Value = CDbl(TextBox20.Text)
If IsNumeric(TextBox21.Text) Then .Cells(lZeile, 21).Value = CDbl(TextBox21.Text)
TextBox22.Value = .Cells(lZeile, 21).Value - .Cells(lZeile - 1, 21).Value
If IsNumeric(TextBox22.Text) Then .Cells(lZeile, 22).Value = TextBox22.Text
.Cells(lZeile, 23).Value = Format(TextBox23.Text, "0 °C")
If IsNumeric(TextBox24.Text) Then .Cells(lZeile, 24).Value = CDbl(TextBox24.Text)
If ListBox1.Text Trim(CStr(TextBox1.Text)) Then
Call UserForm_Initialize
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End If
Exit Do
End If
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End With
End If
ErrExit:
With Err
If .Number 0 Then
MsgBox "Fehler in Prozedur:" & vbTab & "'CommandButton3_Click'" & vbLf & String(60, "_") & _
_
_
vbLf & vbLf & IIf(Erl, "Fehler in Zeile:" & vbTab & Erl & vbLf & vbLf, "") & _
"Fehlernummer:" & vbTab & .Number & vbLf & vbLf & "Beschreibung:" & vbTab & _
.Description & vbLf, vbExclamation + vbMsgBoxSetForeground, _
"VBA - Fehler in Prozedur - CommandButton3_Click"
.Clear
End If
End With
On Error GoTo 0
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlAutomatic
.DisplayAlerts = True
.StatusBar = False
End With
End Sub
'Beenden Schaltfläche Ereignisroutine
Private Sub CommandButton4_Click()
Unload Me
End Sub
Private Sub CommandButton5_Click()
UserForm2.Show
End Sub
'Klick auf die ListBox Ereignisroutine
Private Sub ListBox1_Click()
Dim lZeile As Long
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox5 = ""
TextBox6 = ""
TextBox7 = ""
TextBox8 = ""
TextBox9 = ""
TextBox10 = ""
TextBox11 = ""
TextBox12 = ""
TextBox13 = ""
TextBox14 = ""
TextBox15 = ""
TextBox16 = ""
TextBox17 = ""
TextBox18 = ""
TextBox19 = ""
TextBox20 = ""
TextBox21 = ""
TextBox22 = ""
TextBox23 = ""
TextBox24 = ""
If ListBox1.ListIndex >= 0 Then
lZeile = 4
Do While Trim(Tabelle2.Cells(lZeile, 1).Value) ""
If ListBox1.Text = Trim(Tabelle2.Cells(lZeile, 1).Value) Then
'TextBoxen füllen
TextBox1 = Trim(CStr(Tabelle2.Cells(lZeile, 1).Value))
TextBox2 = Tabelle2.Cells(lZeile, 2).Value
TextBox3 = Tabelle2.Cells(lZeile, 3).Value
TextBox4 = Tabelle2.Cells(lZeile, 4).Value
TextBox5 = Tabelle2.Cells(lZeile, 5).Value
TextBox6 = Tabelle2.Cells(lZeile, 6).Value
TextBox7 = Tabelle2.Cells(lZeile, 7).Value
TextBox8 = Tabelle2.Cells(lZeile, 8).Value
TextBox9 = Tabelle2.Cells(lZeile, 9).Value
TextBox10 = Tabelle2.Cells(lZeile, 10).Value
TextBox11 = Tabelle2.Cells(lZeile, 11).Value
TextBox12 = Tabelle2.Cells(lZeile, 12).Value
TextBox13 = Tabelle2.Cells(lZeile, 13).Value
TextBox14 = Tabelle2.Cells(lZeile, 14).Value
TextBox15 = Tabelle2.Cells(lZeile, 15).Value
TextBox16 = Tabelle2.Cells(lZeile, 16).Value
TextBox17 = Tabelle2.Cells(lZeile, 17).Value
TextBox18 = Tabelle2.Cells(lZeile, 18).Value
TextBox19 = Tabelle2.Cells(lZeile, 19).Value
TextBox20 = Tabelle2.Cells(lZeile, 20).Value
TextBox21 = Tabelle2.Cells(lZeile, 21).Value
TextBox22 = Tabelle2.Cells(lZeile, 22).Value
TextBox23 = Tabelle2.Cells(lZeile, 23).Value
TextBox24 = Tabelle2.Cells(lZeile, 24).Value
Exit Do
End If
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End If
End Sub
Private Sub UserForm_Activate()
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
End Sub
Private Sub UserForm_Initialize()
Dim lZeile As Long
'Alle TextBoxen leer machen
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox5 = ""
TextBox6 = ""
TextBox7 = ""
TextBox8 = ""
TextBox9 = ""
TextBox10 = ""
TextBox11 = ""
TextBox12 = ""
TextBox13 = ""
TextBox14 = ""
TextBox15 = ""
TextBox16 = ""
TextBox17 = ""
TextBox18 = ""
TextBox19 = ""
TextBox20 = ""
TextBox21 = ""
TextBox22 = ""
TextBox23 = ""
TextBox24 = ""
ListBox1.Clear 'Zuerst einmal die Liste leeren
lZeile = 4
Do While Trim(Tabelle2.Cells(lZeile, 1).Value) ""
'Aktuelle Zeile in die ListBox eintragen
ListBox1.AddItem Trim(Tabelle2.Cells(lZeile, 1).Value)
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
End Sub