Vérification saisie InputBox

Version imprimable

03/12/2013, 10h36
turbif08

Vérification saisie InputBox

Bonjour,

J'ai une InputBox dans laquelle je voudrais pouvoir vérifier le format AAAA-MM-JJ ainsi que des intervalles pour les différents champs (AAAA,MM,JJ), je ne vois pas comment faire, j'ai essayé avec une boucle mais sans succès, une piste ?

Merci d'avance
03/12/2013, 11h06
hackoofr

:salut:
Postez votre code et :tagcode:
03/12/2013, 11h17
turbif08

J'ai que mon InputBox du coup...

Code:

TEST = InputBox("Entrer la date","Date","AAAA-MM-JJ")

:salut:
Testez ce :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Titre = "Valider une date"
TEST = InputBox("Entrer la date",Titre,"2013-12-13")
If Not IsDate(TEST)  Then 
	MsgBox "La Date "& DblQuote(TEST) &" n'est pas valide",16,Titre 
Else 
	MsgBox "La Date "& DblQuote(TEST) &" est valide",64,Titre
End If 
'**********************************************************************************************
'Fonction pour ajouter les doubles quotes dans une variable
Function DblQuote(Str)
	DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************

03/12/2013, 14h17
turbif08

J'avais effectivement essayé avec IsDate, le problème c'est que pour IsDate cette date 1-1-1 est correcte alors que pas pour moi, je voudrais par exemple 0001-01-01.

salut,
un exemple vite fait avec l'astuce qui permet de forcer FormatDateTime à sortir le format yyyy-mm-dd qui n'est pas le format européen courant (merci la suède... :mrgreen:)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
curLocale = GetLocale
SetLocale("sv-se")  ' LCID de la suède
rep = InputBox("Entrez la date","Date","AAAA-MM-JJ")
If IsDate(rep) Then
  If Year(rep) > 2013 Or Year(Rep) < 2005 Then
    MsgBox "Année en dehors de l'intervalle"
  Else
    MsgBox "BRAVO LA DATE EST " & FormatDateTime(rep, 2)
  End If
Else
  MsgBox "Format date invalide"
End If
SetLocale(curLocale) ' rétablir les params locaux

Le format ce n'est pas très grave, je le retravaille dans la suite de mon script. Par contre j'ai essayé de faire un plus gros If avec les trois champs :
Code:

1 2 3 4 5 6 rep = InputBox("Entrez la date","Date","AAAA-MM-JJ") If Year(rep) >= 2000 OR Year(rep) <= 2100 AND Month(rep) >= 01 OR Month(rep) <= 12 AND Day(rep) >= 01 OR Day(rep) <= 31 Then MsgBox "Oui" Else MsgBox "Non" End If
Mais je ne passe jamais le Else même quand je le devrais...

Bonjour,

Et avec des parenthèses qui vont bien ?

Code:

1
2
 
If (Year(rep) >= 2000 OR Year(rep) <= 2100) AND (Month(rep) >= 01 OR Month(rep) <= 12) AND (Day(rep) >= 01 OR Day(rep) <= 31) Then

Bon en fait il ne me faut pas de OR mais que des AND :
Code:

1 2 3 4 5 6 rep = InputBox("Entrez la date","Date","AAAA-MM-JJ") If (Year(rep) >= 2010 AND Year(rep) <= 2020) AND (Month(rep) >= 01 AND Month(rep) <= 12) AND (Day(rep) >= 01 AND Day(rep) <= 31) Then MsgBox "Oui" Else MsgBox "Non" End If
Par contre je ne comprends pas, pour l'année ça fonctionne mais pas pour les mois et les jours...

04/12/2013, 11h52
l_autodidacte

Dans ce cas il faudra traiter les mois de 30 jours, de 31 jours et le mois de février (28 ou 29 jours) selon que l'année est bissextile ou non.
04/12/2013, 13h59
turbif08

Non je ne veux pas pousser la vérification jusque-là.

Bonjour,

Je me suis intéressé à cette problématique et voici le code obtenu en fin de développement.
J'ai testé d'abord l'entrée afin que la valeur saisie respecte les contraintes de date de base (en cas de saisie partielle ou avec des valeurs alpha).
J'ai décomposé les vérifications, ce qui rend à mon sens plus facile l'ajout de tests supplémentaires.
J'ai également inversé les opérateurs logiques de comparaisons.
J'ai finalement adapté le code dans une fonction afin de pouvoir la réutiliser plusieurs fois.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 strDateSaisie = InputBox("Entrez une date : ","Date","AAAA-MM-JJ") If strDateSaisie <> "" Then MsgBox "Date [" & strDateSaisie & "] valide : " & checkDate(strDateSaisie) Function checkDate(strDate) strDate = replace(strDate, "/","-") arrDatePart = split(strDate,"-") boolCheckDate = True If Ubound(arrDatePart) = 2 and isNumeric(join(arrDatePart,"")) Then If cint(arrDatePart(0)) < 1900 Or cint(arrDatePart(0)) > 2100 Then boolCheckDate = False If cint(arrDatePart(1)) < 1 Or cint(arrDatePart(1)) > 12 Then boolCheckDate = False If cint(arrDatePart(2)) < 1 Or cint(arrDatePart(2)) > 31 Then boolCheckDate = False Else boolCheckDate = False End If checkDate = boolCheckDate End Function
Bonne journée ! :java:

05/12/2013, 16h53
turbif08

C'est exactement ça, j'en demandais pas tant !

Bon par contre je ne comprends plus rien à partir de ta fonction, mes connaissances en VBS sont bien trop faibles.

Merci beaucoup Zelnist :ccool:

Si tu penses qu'il est utile de vérifier la validité stricte d'une date(nombre de jours et année bissextile) voici comment faire :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
strDateSaisie = InputBox("Entrez une date : ","Date","AAAA-MM-JJ")
If strDateSaisie <> "" Then MsgBox "[" & strDateSaisie & "] : " & IsValidDate(strDateSaisie)
'==========================
Function Bissextile(An)
    Bissextile = (An Mod 4 = 0 And An Mod 100 <> 0) Or (An Mod 400 = 0)
End Function
' =========================
Function IsValidDate(sDate)
    Const  Msg = "Date valide", Msg1 = "Date non valide"
	Dim Ret, tb
	tb = Split(sDate, "-")
	If Ubound(tb) = 2 and isNumeric(join(tb,"")) Then 
		If CInt(tb(0)) < 1900 Or CInt(tb(0)) > 2100  Then Ret = Msg1
		If CInt(tb(1)) < 1 Or CInt(tb(1)) > 12  Then Ret = Msg1
        End If
	Select case CInt(tb(1))
	    Case 1,3,5,7,8,10,12
		   If CInt(tb(2))<=31 Then 
		     Ret = Msg
		   Else :Ret = Msg1
		   End If
	    Case 4,6,9,11
		   If CInt(tb(2))<=30 Then 
		      Ret = Msg
		   Else :Ret = Msg1
		   End If	  
	    Case 2
                   If Bissextile(tb(0)) Then
		      If CInt(tb(2))<=29 Then 
			     Ret = Msg
		      Else :Ret = Msg1
		      End If	  
		   Else 
                        If CInt(tb(2))<=28 Then 
			     Ret = Msg	
                        Else :Ret = Msg1		
			End If
		   End If 
	End Select
	  IsValidDate = Ret
End Function

06/12/2013, 14h27
turbif08

l_autodidacte, je trouve que ça complique le script pour pas grand chose mais ça peut servir à d'autres personnes.

Zelnist, je serais intéressé de connaître la fonction des différentes lignes de ton script.

Salut

Ces problèmes de dates ..........
Une autre approche pour ce qui est de se passer de gérer les années bissextiles

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Option Explicit
Dim Rep
Dim MinDate, MaxDate
Dim CurLocale
 
CurLocale = GetLocale
SetLocale ("sv-se") ' LCID de la suède
 
Rep = InputBox("Entrez la date", "Date (AAAA-MM-JJ)", "AAAA-MM-JJ")
If IsDate(Rep) Then
        SetLocale (1036) ' LCID French (France)
        Rep = CDate(Right(Rep, 2) & "/" & Mid(Rep, 6, 2) & "/" & Left(Rep, 4))
        MinDate = CDate("01/01/2000")
        MaxDate = CDate("31/12/2100")
 
        'MsgBox "MinDate = " & MinDate & vbcrlf _
        '     & "MaxDate = " & MaxDate & vbcrlf _
        '     & "Rep = " & Rep & vbcrlf
    If Rep >= MinDate And Rep <= MaxDate Then
        MsgBox "Bien, dans la fourchette"
        Else
        If Rep >= MinDate Then
                MsgBox "Pas bien, en dehors de la fourchette, date trop grande"
                Else
                MsgBox "Pas bien, en dehors de la fourchette, date trop petite"
        End If
    End If
    Else
    MsgBox "Votre entrée n'est pas une date valide"
End If
 
SetLocale (CurLocale) ' rétablir les params locaux