Fonction validation

Le 21/10/2020 à 16:02

Bonjour

Je cherche une solution pour rentrer mes dates sans faire des fautes de frappe. En utilsant la fonction validation, je pense que c'est le mieux mais comment dire que si la date est supérieure à 10 mais que si je rentre 32 c'est pas bon ou mettre le 29/02/2021 est fausse. Y a t il un moyen de répondre à ce problème

merci

Le 21/10/2020 à 16:05

Bonjour,

Il y a un menu "Autoriser" dans la barre de validation. Vous choisissez Date et ensuite vous mettez une date de début et une date de fin.

A priori les saisies qui ne sont pas des dates seront refusées.

Cdlt,

Le 21/10/2020 à 16:08

Salut,

Je ne comprends pas trop ton problème.

Tu as quels critères pour les dates que tu veux renseigner?

dans la "validation", si tu choisis le format date et que tu prends l'intervalle de temps qui te convient, tu ne pourra pas renseigner des dates qui n'existe pas dans la cellule (par exemple le 32 du mois, ou le 29/02/2021). Par contre,je ne sais pas si tu as d'autre contrainte que ça.

Le 21/10/2020 à 16:13

Dans l'intervalle, déjà les mauvaises dates devraient être refusées et en plus on peut choisir les dates, ex :

=aujourdhui()

en date de fin, toutes les dates supérieures à celle du jour sont bloquées.

Le 21/10/2020 à 16:13

en fait je pensais l'avoir mis dans ma question mais j'ai des dates < 1900

merci

Le 21/10/2020 à 16:17

D'accord, donc toutes les dates sont traités comme du texte, c'est ça ?

Dans ce cas, je reviens bientôt avec une solution...

Le 21/10/2020 à 16:39

Voici une solution, probablement à améliorer, mais qui devrait faire l'affaire :

'DANS LE MODULE DE LA FEUILLE CONCERNEE
Private Sub Worksheet_Change(byval target as range)
if not intersect(target, range("refcellulesconcernees")) is nothing then '<<<<<<<<<< ADAPTER
    if target.value <> "" and target.count = 1 then
        Call ValidationDate(target)
    end if
end if
end sub

'DANS UN MODULE NORMAL
Sub ValidationDate(Cible As Range)

Dim Expreg As Object
Dim chaine$
Dim subdiv, jour, mois, annee

Set Expreg = CreateObject("vbscript.regexp")
chaine = Cible.Value
chaine = Replace(Replace(chaine, "-", "/"), ".", "/")

With Expreg
    .Global = True
    .Pattern = "^[0-9]{1,2}/[0-9]{1,2}(/([0-9]{1,2}|[0-9]{4}))?$"
    If Not .test(chaine) Then GoTo Err
    .Pattern = "[0-9]+"
    Set subdiv = .Execute(chaine)
    jour = subdiv(0)
    mois = subdiv(1)
    if subdiv.count = 3 then annee = subdiv(2) else annee = year(now)
    If Len(annee) < 4 Then annee = 2000 + annee
End With

If jour = 0 Then GoTo Err

Select Case mois
    Case 0, Is > 12: GoTo Err
    Case 2
        If annee Mod 4 = 0 And jour > 29 Then GoTo Err
        If annee Mod 4 > 0 And jour > 28 Then GoTo Err
    Case 4, 6, 9, 11: If jour > 30 Then GoTo Err
    Case Else: If jour > 31 Then GoTo Err
End Select

chaine = Format(chaine, "DD/MM/YYYY")
Application.EnableEvents = False
If Cible.Value <> chaine Then Cible.Value = chaine
Application.EnableEvents = True

Exit Sub

Err:
    MsgBox "Saisie de la date incorrecte !" & vbCrLf & vbCrLf & _
    "Veuillez saisir une date existante au format JJ/MM/AAAA", vbCritical, "Validation des données"
    With Cible
        .ClearContents
        .Activate
    End With

End Sub

Cdlt,

Le 21/10/2020 à 18:56

Merci à tous pour votre travail qui nous facilite la vie

Bonne soirée

Le 21/10/2020 à 19:02

Alors, ça marche bien ?

Les dates avant JC ne sont pas autorisées pour l'instant...

Le 21/10/2020 à 19:26

Bonsoir…

Dans la fenêtre des codes de l’onglet considéré et pour une saisie dans une zone nommée Plage

Private Sub Worksheet_Change(ByVal R As Range)
    If Not Intersect(R, [Plage]) Is Nothing And R.CountLarge = 1 Then
        If Not IsDate(R) Then
           Application.EnableEvents = 0 ‘plus d’évènements rappelés
           R = ""
           Application.EnableEvents = 1 ‘évènements rétablis (ne pas supprimer !)
       End If
    End If
End Sub
Le 21/10/2020 à 20:35

Je testerais demain car je suis au travail

merci

Le 25/10/2020 à 14:21

Bonjour

J'ai mis un peu de temps mais vos macro sont trop complexe pour moi. j'ai testé et je deviens fou.

Vous remercie pour votre travail mais je suis perdu. je m'en excuse

Mille merci.

Claude

Le 25/10/2020 à 14:40

Bonjour,

Je comprends. Il suffit de mettre ce code (modifié pour gérer les années non bissextiles centenaires et commenté) dans un module normal.

Sub ValidationDate(Cible As Range)

Dim Expreg As Object
Dim subdiv as Object
Dim chaine$
Dim jour, mois, annee

Set Expreg = CreateObject("vbscript.regexp")
chaine = Cible.Value
chaine = Replace(Replace(chaine, "-", "/"), ".", "/") 'remplace tous les points et tirets par slash (pour traiter indifferemment)

With Expreg
    .Global = True
    .Pattern = "^\d{1,2}/\d{1,2}(/\d{1,4})?$" 'modele : 1 ou 2 chiffres, "/", 1 ou 2 chiffres, (optionnel : "/", 1 à 4 chiffres)
    If Not .test(chaine) Then GoTo Err
    .Pattern = "\d+" 'modele de subdivision : toute sous-chaine composée exclusivement de chiffres
    Set subdiv = .Execute(chaine)
    jour = subdiv(0)
    mois = subdiv(1)
    If subdiv.Count = 3 Then annee = subdiv(2) Else annee = Year(Now) 'si 3 sous-chaines, annee = derniere sous-chaine, sinon annee = annee en cours
End With

If jour = 0 Then GoTo Err 'jour = 0, erreur

Select Case mois
    Case 0, Is > 12: GoTo Err 'mois = 0 ou supérieur à 12, erreur
    Case 2 'mois février
        If annee Mod 400 = 0 Or (annee Mod 4 = 0 And annee Mod 100 > 0) Then 'années bissextiles (divisibles par 400 ou divisibles par 4 et non par 100)
            If jour > 29 Then GoTo Err
        Else
            If jour > 28 Then GoTo Err 'années non bissextiles
        End If
    Case 4, 6, 9, 11: If jour > 30 Then GoTo Err 'mois à 30 jours
    Case Else: If jour > 31 Then GoTo Err 'autres mois à 31 jours
End Select

chaine = jour & "/" & mois & "/" & annee 'reconstitution chaine

If Not (Len(annee) = 4 And annee < 100) Then 'conversion en date sauf pour années < 100
    chaine = Format(chaine, "DD/MM/YYYY")
End If

Application.EnableEvents = False 'désactivation de l'évènement change
If Cible.Value <> chaine Then Cible.Value = chaine 'valeur cible mise au format souhaité
Application.EnableEvents = True 'réactivation évènement change

Exit Sub

Err: 'si erreur
    MsgBox "Saisie de la date incorrecte !" & vbCrLf & vbCrLf & _
    "Veuillez saisir une date existante au format JJ/MM/AAAA", vbCritical, "Validation des données" 'message
    With Cible
        .ClearContents 'contenu de la cible supprimé
        .Activate 'cible activée
    End With

End Sub

Ensuite, de mettre celui-ci dans un module de feuille. Si votre validation concerne la "Feuil1". Vous cliquez sur "Feuil1" de la fenêtre de projets juste à gauche (a priori) de l'éditeur. Et vous collez ce code :

Private Sub Worksheet_Change(byval target as range)
if not intersect(target, range("refcellulesconcernees")) is nothing then '<<<<<<<<<< ADAPTER
    if target.value <> "" and target.count = 1 then
        Call ValidationDate(target)
    end if
end if
end sub

Dans le second code, vous modifiez "refcellulesconcernees" par "A1" par exemple si la validation porte sur la cellule A1 de la "Feuil1".

Et c'est bon...

Ensuite vous vous rendez en A1 et vous faites vous tests en saisissant des dates valides et invalides pour vérifier que la validation se passe comme vous le désirez.

Cdlt,

Le 25/10/2020 à 15:23

Bonjour à tous,

autre proposition, plus simple au niveau du contrôle de validité.
Permet 2 types de retour. Le 2nd avec année en tête permet le tri si besoin.

Private Sub Worksheet_Change(ByVal Target As Range)
    ' valide et retourne une date en texte (car certaines < 01/01/1900)
    Const formatDate = 1
    'formatDate = 1 : jj/mm/aaaa en texte
    'formatDate = 2 : aaaa-mm-jj en texte, permet le tri
    Dim dat, d As Date

    If Target.Column = 2 Then ' adapter au besoin
        dat = Split(Target, "/")
        If UBound(dat) <> 2 Then GoTo erreur
        d = DateSerial(dat(2) + 2000, dat(1), dat(0))
        If Day(d) <> Val(dat(0)) Then GoTo erreur
        If Month(d) <> Val(dat(1)) Then GoTo erreur
    End If
    Application.EnableEvents = False
    Select Case formatDate
    Case 1
        Target = format(dat(0), "00") & "/" & format(dat(1), "00") & "/" & format(dat(2), "0000")
    Case 2
        Target = format(dat(2), "0000") & "-" & format(dat(1), "00") & "-" & format(dat(0), "00")
    End Select
    Application.EnableEvents = True
    Exit Sub
erreur:
    Target.Select: MsgBox ("Date non valide, ressaisir")
End Sub

Ici colonne B supervisée, à adapter

eric

8date-inf-1900.xlsm (17.42 Ko)
Rechercher des sujets similaires à "fonction validation"