Test date réelle

Résolu
geo3701 Messages postés 60 Statut Membre -  
pijaku Messages postés 13513 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

3 réponses

  1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    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
  2. geo3701 Messages postés 60 Statut Membre 1
     
    Merci de cette réponse rapide.

    J'utilise du jj/mm/aaaa
    0
  3. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    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
    1. geo3701 Messages postés 60 Statut Membre 1
       
      Ca a l'air de très bien fonctionner au premier abord!

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