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
| Function SwitchFrToUs(DateEntree)
Dim tabPos(2) ' Sauve les positions des caractères '/' dans un tableau
Dim i As Long ' Indice du tableau tabPos qui est incrémenté à chaque rencontre du caractère. '/'
Dim intCpt As Long ' Compteur de la chaine DateEntree
Dim intPos As Long ' Initialisé la position de l'élément à rechercher
Dim AAAA As String, MM As String, JJ As String
i = 1
intCpt = 1
intPos = -1
' Traitement
While (intPos <> 0) ' tant que pas fin de chaîne
intPos = InStr(intCpt, DateEntree, "/")
If intPos <> 0 Then
tabPos(i) = intPos
intCpt = intPos + 1 'pour ne pas faire de boucle infinie
End If
i = i + 1
Wend
' Si FR to US
If tabPos(1) = 3 Then
JJ = Left(DateEntree, tabPos(1) - 1)
MM = Mid(DateEntree, tabPos(1) + 1, (tabPos(2) - tabPos(1)) - 1)
AAAA = Mid(DateEntree, tabPos(2) + 1, 4)
DateOut = AAAA & "/" & MM & "/" & JJ ' on formate la chaîne de sortie Format US
Else
' Si US to FR
AAAA = Left(DateEntree, tabPos(1) - 1)
MM = Mid(DateEntree, tabPos(1) + 1, (tabPos(2) - tabPos(1)) - 1)
JJ = Mid(DateEntree, tabPos(2) + 1, 4)
DateSortie = JJ & "/" & MM & "/" & AAAA ' on formate la chaîne de sortie Format FR
End If
' Return
SwitchFrToUs = DateSortie
End Function |
Partager