Dates indomptables sous VBA

Bonjour

Je fais appel à vos lumières, n'ayant rien trouvé sur le forum. J'ai le problème suivant, sous VBA dans Excel. J'aimerais que dans la cellule d'une feuille, l'utilisateur saisisse une date. Seul format accepté: jjmmaaaa (ex: 03072004, sans points, ni tirets ni espaces). La macro présente dans la fonction CHANGE doit évaluer si la date a bien ce format-là (tout autre format doit être refusé). Elle doit aussi vérifier si la date existe (ex 29022003 = invalide) et si elle se situe après 1900 et avant 2050. Lorsque tous ces contrôles sont passés, VBA convertit le format TEXTE de la date au format DATE.

Un informaticien m'a rédigé le code ci-dessous, qui fonctionne? presque! Exemple: si l'utilisateur saisit 04.08.04 (format erroné), Excel réagit. Mais après avoir effacé la valeur, tapé une autre date au format correct, si je retape 04.08.04, cette fois-ci VBA ne détecte plus l'erreur. Si quelqu'un a la clé du mystère ainsi que des modifications à apporter au code, je suis preneur. Casse-tête, en tout cas pour moi. Merci d'avance, folks!

Voici le code:

Private PremierPassage As Boolean

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim ContenuDate
Dim ErreurRencontree As Boolean
ContenuDate = Range("D13").Text
ErreurRencontree = False

If Target.Address = "$D$13" Then
If Range("D13").Text = "" Then
Range("D13").NumberFormat = "@"
'MsgBox ("Aucune donnée")
'ElseIf Len(Range("D13").Text) <> 8 Or Not IsNumeric(Range("D13").Text) Then
'MsgBox ("Pas 8 chiffres ou pas numérique")
Else
If Len(Range("D13").Text) = 8 And IsNumeric(Range("D13").Text) Then
If Mid(ContenuDate, 5, 4) > 1900 And Mid(ContenuDate, 5, 4) < 2050 Then
If IsDate(Mid(ContenuDate, 1, 2) & "/" & Mid(ContenuDate, 3, 2) & "/" & Mid(ContenuDate, 5, 4)) Then
PremierPassage = True
Range("D13").Value = Mid(ContenuDate, 1, 2) & "/" & Mid(ContenuDate, 3, 2) & "/" & Mid(ContenuDate, 5, 4)
Range("D13").NumberFormat = "dd\/mm\/yyyy"
MsgBox ("Date ok"), vbInformation, "Tout va bien !"
Else
ErreurRencontree = True
MsgBox "Date inexistante", vbExclamation, "Erreur"
End If
Else
ErreurRencontree = True
MsgBox "Date pas dans les bornes", vbExclamation, "Erreur"
End If
Else
If Not PremierPassage Then
ErreurRencontree = True
MsgBox ("Saisie invalide"), vbExclamation, "Erreur"
PremierPassage = False
End If
End If
End If
If ErreurRencontree Then
Range("D13").Select
Selection.ClearContents
Range("D13").NumberFormat = "@"
Range("D13").Select
End If
End If

End Sub


tiberus

Son codes est pas mal !
Moi perso j'aurais plutot essayer d'interdire la frappe des touches "." "/" et tou les caractères spéciaux par des fonction :

Private Sub Worksheet_KeyPress(KeyAscii As Integer)
If Not Chr(KeyAscii) Like "[0123456789]" And KeyAscii = 40 Then KeyAscii = 0
End Sub

voila !
Mais n'ayant pas tester je ne peut pas t'affirmer a 100% ke sa marchera !

Oui, mais je ne pense pas que ta solution soit utilisable, puisque le contrôle se fait directement sur la cellule d'une feuille (et non un userform, trop capricieux à régler pour mes connaissances approximatives). L'option KEYPRESS n'est donc pas disponible. Où je me trompe? VBA peut-il quand même détecter quelles touches ont été pressées avec la fonction CHANGE? No sé

tiberus

Pkoi se casser la tête à réécrire des fonctions qui existe déjà sous vba. Il y a une fonction IsDate inclu dans vba qui te retourne un Booléen. Du coup tu fais :
If IsDate(Valeur à tester) then
Action à effectuer si la date est bonne
Else
Action à effectuer si la date est mauvaise
End if

Voilà c tt