VBA Fenster verändert Datum format

Private Sub CB_Eintragen_Click()
Dim ws As Worksheet
Set ws = Worksheets("KVP")
Dim wsdaten As Worksheet
Set wsdaten = Worksheets("Daten")
Dim datum As String
Nachricht = 0
If Nachricht = 0 Then
Application.ScreenUpdating = False
anzahlzeile = ws.UsedRange.Rows.Count
tag1 = Left(TB_Datum.Value, 2)
monat1 = Mid(TB_Datum.Value, 4, 2)
jahr1 = Right(TB_Datum.Value, 4)
ws.Cells(anzahlzeile + 1, 2).Value = tag1 & "." & monat1 & "." & jahr1
ws.Cells(anzahlzeile + 1, 2).NumberFormat = "dd.mm.yyyy"
ws.Cells(anzahlzeile + 1, 3).Value = TB_Unternehmen.Value
ws.Cells(anzahlzeile + 1, 4).Value = TB_Bereich.Value
ws.Cells(anzahlzeile + 1, 5).Value = TB_Bereichsverantw.Value
ws.Cells(anzahlzeile + 1, 6).Value = TB_Dauer.Value
ws.Cells(anzahlzeile + 1, 7).Value = TB_Name.Value
ws.Cells(anzahlzeile + 1, 8).Value = TB_Problem.Value
ws.Cells(anzahlzeile + 1, 9).Value = TB_Maßnahme.Value 'Vorschlag / Maßnahme
ws.Cells(anzahlzeile + 1, 11).Value = TB_Verantwortlicher.Value
ws.Cells(anzahlzeile + 1, 12).Value = TB_Status.Value
For a = 2 To wsdaten.Cells(Rows.Count, 4).End(xlUp).Row
If TB_Bereich.Text = wsdaten.Cells(a, 2).Value Then
End If
Next a
ws.Rows(anzahlzeile + 1).EntireRow.AutoFit
For a = 1 To 15
ws.Cells(anzahlzeile + 1, a).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Next a
UF_NeuerEintrag.Hide
End If
Application.ScreenUpdating = True
End Sub

Private Sub Label2_Click()
End Sub

Private Sub Label20_Click()
End Sub

Private Sub Label7_Click()
End Sub

Private Sub Check_Click()
'If check.Value = True Then
'    TB_Name.Style = fmStyleDropDownCombo
'End If
'If check.Value = False Then
'    TB_Name.Style = fmStyleDropDownList
'End If
'End Sub

Private Sub TB_Bereich_Change()
Dim ws As Worksheet
Set ws = Worksheets("KVP")
Dim wsdaten As Worksheet
Set wsdaten = Worksheets("Daten")
For a = 2 To wsdaten.Cells(Rows.Count, 4).End(xlUp).Row
If TB_Bereich.Text = wsdaten.Cells(a, 2).Value Then
TB_Unternehmen.Value = wsdaten.Cells(a, 4).Value
TB_Bereichsverantw.Value = wsdaten.Cells(a, 3).Value
End If
Next
End Sub

Private Sub TB_Datum_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If InStr("1234567890." & Chr$(8), Chr$(KeyAscii)) = 0 Then
KeyAscii = 0
End If
TB_Datum.MaxLength = 10
End Sub

Private Sub TB_Datum_AfterUpdate()
If TB_Datum.Value  "" Then
If Len(TB_Datum.Value)  10 Or Mid(TB_Datum.Value, 3, 1)  "." Or Mid(TB_Datum.Value, 6, 1)  "." Then
MsgBox "Bitte das Datum im Format 'DD.MM.JJJJ' eingeben"
TB_Datum.Value = ""
End If
End If
If TB_Datum.Value  "" Then
If Not IsDate(TB_Datum.Value) Then
MsgBox "Bitte ein gültiges Datum eingeben"
TB_Datum.Value = ""
End If
End If
End Sub

Private Sub TB_Dauer_Change()
If TB_Dauer.Value  "Boris" Then
TB_Maßnahme.Enabled = True
TB_Problem.Enabled = True
TB_Maßnahme.BackColor = &H80000005
TB_Problem.BackColor = &H80000005
TB_Status.Enabled = True
TB_Status.BackColor = &H80000005
TB_Verantwortlicher.Enabled = True
TB_Verantwortlicher.BackColor = &H80000005
Label12.Font.Bold = True
Label14.Font.Bold = True
Label8.Font.Bold = True
Label9.Font.Bold = True
End If
End Sub

Private Sub TB_Grund_Change()
End Sub

Private Sub TB_Name_Change()
End Sub

Private Sub TB_Problem_Change()
Länge = Len(TB_Problem.Value)
Label_Problem.Caption = 120 - Länge
End Sub

Private Sub TB_Maßnahme_Change()
Länge = Len(TB_Maßnahme.Value)
Label_Maßnahme.Caption = 120 - Länge
End Sub