Dates indomptables sous VBA

Question

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

Crash_overide12 · Answer

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 !

tiberus · Answer

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

ozar · Answer

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

Dates indomptables sous VBA

3 réponses

Discussions similaires