Private Const JoursSemaine = "dimanche,lundi,mardi,mercredi,jeudi,vendredi,samedi"
Private Const MoisAnnée = "janvier,février,mars,avril,mai,juin,juillet,août,septembre,octobre,novembre,décembre"
'-------------------------
'Valeur texte est une date
'-------------------------
Private Function IsDateTexte(ByVal Val As String, Valeur As Variant, NumberFormat As String) As Boolean
Dim TabDate() As String
Dim TabHeure() As String
Dim i As Integer
Dim j As Integer
Dim Sep As String
Dim JourSemaineTrouvé As Boolean
Dim SepJourSemaine As String
Dim FormatJourSemaine As String
Dim LenJourSemaine As Integer
Dim HeureTrouvée As Boolean
Dim FormatHeure As String
Dim S As String
Static TabJours() As String
'Initialisations
Valeur = ""
NumberFormat = ""
'Initialisation TabJours()
If Not (Not TabJours) Then Else TabJours = Split(JoursSemaine, ",")
'Nombre en texte n'est pas une date
If IsNumeric(Val) Then Exit Function
'Excel ne reconnait pas comme une date un texte "dimanche 6 décembre 2020", il faut l'aider
'-----------------------------------
'Format date avec jour de la semaine
'-----------------------------------
For i = LBound(TabJours) To UBound(TabJours)
If Left(Val, Len(TabJours(i))) = TabJours(i) Then Exit For
Next i
If i <= UBound(TabJours) Then
JourSemaineTrouvé = True
FormatJourSemaine = "dddd"
LenJourSemaine = Len(TabJours(i))
Else
For i = LBound(TabJours) To UBound(TabJours)
If Left(Val, 3) & "." = Left(TabJours(i), 3) & "." Then Exit For
Next i
If i <= UBound(TabJours) Then
JourSemaineTrouvé = True
FormatJourSemaine = "ddd"
LenJourSemaine = 4
End If
End If
If JourSemaineTrouvé Then
'Retire le jour et le séparateur de la valeur texte
If Len(Val) > LenJourSemaine + 1 Then
S = Mid(Val, LenJourSemaine + 2)
If IsDate(S) Then
If Weekday(CDate(S)) = i + 1 Then
SepJourSemaine = Mid(Val, LenJourSemaine + 1, 1)
Val = S
End If
End If
End If
End If
'---------------------
'Ce n'est pas une date
'---------------------
If Not IsDate(Val) Then Exit Function
'-------------------------
'Conversion en date locale
'-------------------------
Valeur = CDate(Val)
'----------------------
'Format date avec heure
'----------------------
TabDate = Split(Val, " ")
TabHeure = Split(TabDate(UBound(TabDate)), ":")
HeureTrouvée = False
If UBound(TabHeure) = 1 Then
If IsNumeric(TabHeure(0)) And IsNumeric(TabHeure(1)) Then
FormatHeure = "h:mm"
HeureTrouvée = True
End If
End If
If UBound(TabHeure) = 2 Then
If IsNumeric(TabHeure(0)) And IsNumeric(TabHeure(1)) And IsNumeric(TabHeure(2)) Then
FormatHeure = "h:mm:ss"
HeureTrouvée = True
End If
End If
If HeureTrouvée Then
'Retire l'heure de la valeur texte
Val = ""
For j = LBound(TabDate) To UBound(TabDate) - 1
If Len(Val) > 0 Then Val = Val & " "
Val = Val & TabDate(j)
Next j
End If
'--------------------------------------------
'Tentatives pour quelques formats de dates
'en excluant le jour de la semaine et l'heure
'qui sont traités séparément ci-dessus
'--------------------------------------------
Do While 1
For i = 1 To 3
Select Case i
Case 1
Sep = "/"
Case 2
Sep = " "
Case 3
Sep = "-"
End Select
TabDate = Split(Val, Sep)
'mmm/yy ou mmm/yyyy ou mmm yy ou mmmm yyyy ou mmm-yy ou mmmm-yyyy
If UBound(TabDate) = 1 Then
If Not IsNumeric(TabDate(0)) And IsNumeric(TabDate(1)) Then
NumberFormat = FormatMois(TabDate(0)) & Sep & _
String(Len(CStr(TabDate(1))), "y")
Exit Do
End If
End If
'dd/mm/yy ou dd/mm/yyyy ou dd mm yy ou dd mm yyyy ou dd-mm-yy ou dd-mm-yyyy
If UBound(TabDate) = 2 Then
If IsNumeric(TabDate(0)) And IsNumeric(TabDate(1)) And IsNumeric(TabDate(2)) Then
NumberFormat = String(Len(TabDate(0)), "d") & Sep & _
"mm" & Sep & _
String(Len(CStr(TabDate(2))), "y")
Exit Do
End If
End If
'dd/mmm/yy ou dd/mmm/yyyy ou dd mmm yy ou dd mmmm yyyy ou dd-mmm-yy ou dd-mmmm-yyyy
If UBound(TabDate) = 2 Then
If IsNumeric(TabDate(0)) And Not IsNumeric(TabDate(1)) And IsNumeric(TabDate(2)) Then
NumberFormat = String(Len(TabDate(0)), "d") & Sep & _
FormatMois(TabDate(1)) & Sep & _
String(Len(CStr(TabDate(2))), "y")
Exit Do
End If
End If
Next i
Exit Do
Loop
'Ajoute le jour de la semaine si détecté
If JourSemaineTrouvé Then NumberFormat = FormatJourSemaine & SepJourSemaine & NumberFormat
'Ajoute l'heure si détéctée
If HeureTrouvée Then NumberFormat = NumberFormat & IIf(Len(NumberFormat) > 0, " ", "") & FormatHeure
'Format par défaut
If Len(NumberFormat) = 0 Then NumberFormat = "m/d/yyyy"
IsDateTexte = True
End Function
Private Function FormatMois(Mois As String) As String
Dim i As Integer
Static TabMois() As String
'Initialisation TabMois()
If Not (Not TabMois) Then Else TabMois = Split(MoisAnnée, ",")
For i = LBound(TabMois) To UBound(TabMois)
If Mois = TabMois(i) Then Exit For
Next i
If i <= UBound(TabMois) Then FormatMois = "mmmm" Else FormatMois = "mmm"
End Function