Nnnno,
nechce ma to poslúchať (potrebujem prevody medzi formátmi a nejak mi to nejde), tak som to vyriešil okľukou amatérsky, ale funkčne.
Potrebujeme dve bunky ako pomocné (v danom prípadne sú to E1 a E2, ak to nebude vyhovovať, vzhľadom na hlavičku, prehoď si to inde), kde sa vyhodnotí korektnosť dátumu, takže nie je potrebné žiadne ošetrovanie desatinných čiarok, rozsahov dátumov alebo iných habaďúr, či ide naozaj o dátum.
Do kódu som vložil aj naplnenie bunky E2 vzorcom, zneviditeľnenie obsahu pomocných buniek a farebné zvýraznenie bunky s chybou v dátume, aby si ani s tým nemal starosť (stačilo by ich tam raz dať manuálne ale aj o to som Ťa odľahčil. Takto sa to síce každým dátumom napĺňa opakovane, ale to nevadí).
A formát stĺpcov, do ktorých sa budú tieto dátumy zadávať musíš nastaviť na "text", inak za určitých okolností môže dôjsť k chybe (inak aj to by sa dalo dať do kódu)
Skús
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Chyba
Application.EnableEvents = False
If (Target.Column <> 1 _
And Target.Column <> 2 _
And Target.Column <> 3 _
And Target.Column <> 4 _
And Target.Column <> 6) _
Or Target.Row < 5 Or Target = "" Then
Application.EnableEvents = True
Exit Sub
End If
If Mid(Target, 5, 1) > 4 Then
Stoleti = 19
Else: Stoleti = 20
End If
Target = Left(Target, 2) & "." & Mid(Target, 3, 2) & "." & Stoleti & Right(Target, 2)
'pomocné bunky E1 a E2
Range("E1:E2").NumberFormat = ";;;"
Range("E1") = Target
Range("E2").FormulaR1C1 = "=IF(ISERROR(DATEVALUE(R[-1]C)),""Chyba"","""")"
If Range("E2") = "Chyba" Then
Target.Font.Color = RGB(255, 0, 0)
Target.Select
MsgBox "Zadaný údaj nereprezentuje dátum!" & Chr(13) & "Oprav!", vbCritical, "Chyba"
Else: Target.Font.Color = RGB(0, 0, 0)
End If
Application.EnableEvents = True
Exit Sub
Chyba:
MsgBox "Iná chyba"
Application.EnableEvents = True
Exit Sub
End Sub