Test date réelle

Résolu
geo3701 Messages postés 58 Date d'inscription   Statut Membre Dernière intervention   -  
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   -
Bonjour à tous,

J'ai un fichier Excel où je rentre des dates.
Afin d'éviter toute faute de frappe, je voudrais faire une macro de type :
Sub Worksheet_Change(ByVal Target As Range).

J'ai tenté d'utiliser la fonction isDate mais celle-ci ne vérifie pas si la date existe réellement, à savoir qu'on peut taper "32/02/14"...

Avez-vous la solution miracle?

Merci d'avance
A voir également:

3 réponses

Réponse 1 / 3
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Bonjour,

Haaa ce problème de dates sous Excel...
32/02/14 est considéré par VBA comme étant le 14 février 2032 donc comme étant une date valide.

Pour pallier ce souci, il nous faut connaitre le ou les formats de saisie que tu utilises.
Soit tu saisis toujours tes dates au format jj/mm/aa soit tu peux en utiliser d'autres.
Par exemple :
mm/jj/aa
jj/mm/aaaa
etc...
Dis nous
0
Réponse 2 / 3
geo3701 Messages postés 58 Date d'inscription   Statut Membre Dernière intervention   1
 
Merci de cette réponse rapide.

J'utilise du jj/mm/aaaa
0
Réponse 3 / 3
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Réponse un peu moins rapide...
A tester... 

Private Sub Worksheet_Change(ByVal Target As Range)
'ici on ne vérifiera les dates que pour la 4ème colonne (D) si la cellule n'est pas vide
If Target.Column <> 4 Or Target.Value = "" Then Exit Sub

If Not EstUneDate(CStr(Target.Value)) Then
    Application.EnableEvents = False
    Target.Value = ""
    Application.EnableEvents = True
    MsgBox "La date saisie n'est pas valide!", vbCritical
End If
End Sub

Function EstUneDate(maDate As String) As Boolean
Dim Jour As Integer, Mois As Integer, Annee As Integer

EstUneDate = False
On Error GoTo TraiteErreur
Jour = CInt(Left(maDate, 2))
If Jour < 1 Then GoTo TraiteErreur
Mois = CInt(Mid(maDate, 4, 2))
If Mois < 1 Or Mois > 12 Then GoTo TraiteErreur
Annee = CInt(Right(maDate, 4))
Select Case Mois
    Case 1, 3, 5, 7, 8, 10, 12 'mois de 31 jours
        If Jour > 31 Then GoTo TraiteErreur
    Case 4, 6, 9, 11 'mois de 30 jours
        If Jour > 30 Then GoTo TraiteErreur
    Case 2 'mois de février
        If Annee Mod 4 = 0 Or Annee Mod 400 = 0 Then
            'années bissextiles
            If Jour > 29 Then GoTo TraiteErreur
        Else
            'années NON bissextiles
            If Jour > 28 Then GoTo TraiteErreur
        End If
End Select
EstUneDate = True
TraiteErreur:
Exit Function
End Function

Sub EnCasDePlantageDeMacro()
    Application.EnableEvents = True
End Sub
0
geo3701 Messages postés 58 Date d'inscription   Statut Membre Dernière intervention   1
 
Ca a l'air de très bien fonctionner au premier abord!

Merci
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Et bien tant mieux.
de rien.
A+
0