Soyez le premier à donner votre avis sur cette source.
Snippet vu 9 162 fois - Téléchargée 18 fois
Function ConverDate(DateN As String) As String Dim LongN As Integer Dim Index As Integer Dim Coupe As String Dim DNais As String LongN = Len(DateN) If LongN = 0 Then Exit Function ' On ne retient que les chiffres For Index = 1 To LongN 'On extrait un caractere Coupe = Right(DateN, 1) 'on verifie qu'il s'agit d'un chiffre If Asc(Coupe) > 47 And Asc(Coupe) < 58 Then DNais = Coupe & DNais End If 'on soustrait le caractere extrait DateN = Left(DateN, LongN - Index) Next Index ' On verifie le format du resultat '******************* LongN = Len(DNais) If LongN = 6 Then ' format 22/10/72 GoTo Reconstruction6 Else If LongN = 8 Then GoTo Reconstruction8 ' format 22/10/1972 Else GoTo erreur End If End If Reconstruction6: 'pour les date au format 01/01/01******************* DateN = "" For Index = 2 To LongN Step 2 'On extrait deux caracteres Coupe = Right(DNais, 2) If Len(DateN) < 2 Then 'On recontruit l'année au format voulu DateN = Coupe Else If Len(DateN) = 2 Then 'Gestion du mois If Val(Coupe) = 0 Or Val(Coupe) > 12 Then GoTo erreur 'On recontruit le mois DateN = Coupe & "/" & DateN Else 'Gestion du jour If Val(Coupe) = 0 Or Val(Coupe) > 31 Then GoTo erreur 'On recontruit le jour DateN = Coupe & "/" & DateN End If End If 'on supprime de la date source la partie extraite DNais = Left(DNais, LongN - Index) Next Index ConverDate = DateN Exit Function Reconstruction8: 'pour les date au format 01/01/1901 *************** DateN = "" For Index = 2 To LongN Step 2 'On extrait deux caracteres Coupe = Right(DNais, 2) If Len(DateN) < 4 Then 'On recontruit l'année au format "1990" DateN = Coupe & DateN Else If DateN > Year(Date) Then GoTo erreur2 If Len(DateN) = 4 Then 'Gestion du mois If Val(Coupe) = 0 Or Val(Coupe) > 12 Then GoTo erreur 'On recontruit le mois DateN = Coupe & "/" & DateN Else 'Gestion du jour If Val(Coupe) = 0 Or Val(Coupe) > 31 Then GoTo erreur 'On recontruit le jour DateN = Coupe & "/" & DateN End If End If 'on supprime de la date source la partie extraite DNais = Left(DNais, LongN - Index) Next Index 'On renvoi le resultat ConverDate = DateN Exit Function erreur: '************************************************************ erreur = MsgBox("Le format de la date n'est pas valide.") erreur2: '*********************************************************** erreur2 = MsgBox("Ce jour n'est pas encore arrivé.") End Function
' pas de "/" If (InStr(1, sDate, "/") 0) And ((LenB(sDate) 12) Or (LenB(sDate) = 16)) Then
sDate = LeftB$(sDate, 4) & "/" & MidB$(sDate, 5, 4) & "/" & MidB$(sDate, 9)
End If
Mais sans vouloir te paraitre têtu, voir chi...Autant qu'utilisateur, j'apprécie de pouvoir saisir une date sans separateurs.22101972 pour la voir validé en 22/10/1972. mais peut-être suis-je le seul?!
Mais voyant ton niveau et le mien,c'est sans doute beaucoup de ligne pour peu de choses, j'en conviens.
Merci de ta participation.
tu peux cumuler la fonction format avec une gestion d'erreur et une vérification avec IsDate, il n'en faut pas plus!
Function ConvertDate(ByRef sDate As String, Optional bBeforeNow As Boolean = True) As Boolean
Dim dRet As Date
On Local Error Resume Next
dRet = Format(sDate, "DD/MM/YYYY") If Err.Number 0 Then ConvertDate IsDate(dRet) Else Err.Clear
If ConvertDate Then If bBeforeNow And (CLng(dRet) >CLng(Date)) Then ConvertDate False
If ConvertDate Then sDate = CStr(dRet)
End If
End Function
Merci de ton interet,mais je ne suis pas d'accord avec toi, en effet:
si LaDateChaine = "21à12@1990"
madate = Format(LaDateChaine, "DD/MM/YYYY") renvoi 21à12@1990
de même si si LaDateChaine = "21121990" une erreur "depassement de capacité" intervient.
Le but de cette fonction est de palier à l'absence de separateur ou au séparateurs non conforme à une date.
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.