XL 2021 VBA - Est-ce que le format d'une cellule est un format de type Date (quelconque)

[Dudu2]

Bonjour,

Est-ce que cette fonction répond de manière sûre à la question ?

Function FormatCellIsDate(Cell As Range) As Boolean
    If IsDate(Format(0, Cell.NumberFormat)) Then
        'Return Value
        FormatCellIsDate = True
    End If
End Function

 

[sylvanu]

Re,
ChatGPT propose une astuce : regarder si le format contient "j" "m" ou "a".
Marche que si XL est en français, ne marche pas pour des formats personnalisés du type 0"km" ou 0"ans" ou 0"jours".
Mais peut être suffisant pour votre appli. Avec :

Function EstFormatDate(cellule As Range) As Boolean
    Dim formatCellule As String
    formatCellule = cellule.NumberFormat
    formatCellule = LCase(formatCellule) ' pour insensibilité à la casse
    If InStr(formatCellule, "d") > 0 Or InStr(formatCellule, "m") > 0 Or InStr(formatCellule, "y") > 0 Then
        EstFormatDate = True
    Else
        EstFormatDate = False
    End If
End Function

 

[Dudu2]

ChatGPT propose une astuce : regarder si le format contient "j" "m" ou "a".

C'est ce que j'étais précisément en train d'analyser !

Je vais essayer le VarType bien que je pense que ça s'applique à la valeur et pas au format.
Edit: c'est bien ce que je pensais, ça n'identifie pas le format

ChatGPT est sans doute le plus judicieux. C'est déprimant !

Edit: et le fichier adapté

 

[dysorthographie]

Re,
ChatGPT propose une astuce : regarder si le format contient "j" "m" ou "a".
Marche que si XL est en français, ne marche pas pour des formats personnalisés du type 0"km" ou 0"ans" ou 0"jours".

il m'a donné la même solution mais quand je lui précise que le samedi 6 juillet 2025 n'est pas une date il pare en vrille, quel mauvais joueur ce chatgpt

 

[Staple1600]

Bonjour le fil

Il y a aussi : =CELLULE("format";$A$1) qui renvoie D1,D2,D3,D4 ou D5 si A1 a un format date
(ou plutôt un de ces cinq formats)

m/j/aa, m/j/aa h:mm ou mm/jj/aa	"D4"
j-mmm-aa ou jj-mmm-aa	"D1"
j-mmm ou jj-mmm	"D2"
mmm-aa	"D3"
mm/jj	"D5"

source

 

[Dudu2]

Bonjour @Staple1600

Ça fonctionne pour un certain nombre de formats Date (sans doute les plus courants) mais pas dans les cas marginaux.

 

[sylvanu]

Re,
Ou alors le marteau pour écraser une fourmi, une approche exhaustive proposée par Mistral réservée aux plus courageux :

Function IsDateFormat(cell As Range) As Boolean
    Dim dateFormats As Variant
    Dim i As Integer
    ' Liste des formats de date courants, à compléter pour tous les formats.
    dateFormats = Array("mm/dd/yyyy", "dd/mm/yyyy", "mm-dd-yy", "dd-mm-yy", "yyyy-mm-dd", "mm/dd;@", "dd/mm;@", _
                "mm-dd;@", "dd-mm;@", "[$-fr-FR]dd/mm/yyyy", "[$-en-US]mm/dd/yyyy", "dddd dd mmm yyyy", _
                "ddd dd mm yy", "dddd dd mmm", "dd mmm yyyy", "d m yy")
    ' Vérifie si le format de la cellule correspond à l'un des formats de date
    For i = LBound(dateFormats) To UBound(dateFormats)
        If cell.NumberFormat = dateFormats(i) Then
            IsDateFormat = True
            Exit Function
        End If
    Next i
End Function

 

[Dudu2]

C'est la GBU-57 du format Date ! 😱

Il y a cependant des lacunes car on peut très bien indiquer des séparateurs uniques ou multiples différents (ex "jj:mm:aaaa")
Et une question car il cite "[$-fr-FR]" mais dans un des formats j'ai trouvé directement "[$-F800]".

 

[sylvanu]

C'est le souci. Il est exhaustif si la liste l'est.
C'était pour le fun. Dehors il pleut. 🙂

 

[TooFatBoy]

Dehors il pleut. 🙂

Oui. Vais être obligé de prendre un parapluie pour aller arroser... ☹️

 

[Dudu2]

Et moi il faut que je rentre mon singe qui lèche. L'orage se pointe.

 

[patricktoulon]

Bonsoir
ha ouais là on est bien

ok je sort

 

[Dudu2]

Bonsoir @patricktoulon,
J'étais étonné de ne pas encore te voir dans ce fil !

Alors je te le dis, tu peux rester, car "jedorsdebout" est bel et bien un format date.
Pour la date du 06/07/2025 ça donne ça.

Après faut aimer voir une date comme ça ! 😂

 

[Dudu2]

Ceci dit, si "jedorsdebout" est indiqué comme format entre doubles-quotes, la reconnaissance du format Date ne fonctionne plus.
Pour parfaire le traitement, il faut retirer tout ce qui est entre doubles-quotes.

 

[patricktoulon]

allez j'ai juste voulu vous montrer que le test "d" "m" "y" est loin d'être suffisant
permet moi de t'en proposer une autre

'patricktoulon
'quasiment tout les formats de date sont détectés
'dd/mm/yyyy

'dd -mm - yyyy
'dd mm yyyy ? ? espace
'yyyy.mm.dd
'd m yy
'd -mmm - yyyy
'yyyy , mm, dd
'dd mmm (date partielle)
'mmm yyyy
'etc....
'etc....
Sub test()
    For i = 18 To 24
        MsgBox Cells(i, 1).Text & vbCrLf & Cells(i, 1).NumberFormat & vbCrLf & vbCrLf & EstFormatDate(Cells(i, 1))
    Next
End Sub

Function EstFormatDate(cel As Range) As Boolean
    Dim nbF As String
    nbF = LCase(cel.NumberFormat)
    'suppression des caractères genants utilisé éventuellement dans le pattern
    ' sauf le separateur de date bien sur!!!, lui on l'échappe dans le pattern
    nbF = Replace(Replace(Replace(nbF, """", ""), "$", ""), "€", "")
    With CreateObject("VBScript.RegExp")
        .IgnoreCase = True
        .Global = False
        ' On cherche au moins deux composantes (d, m, y) parmi les trois, séparées par des séparateurs
        .Pattern = "\b(?:d{1,4}|m{1,4}|y{2,4})([\s\/\-,\.]*)" & _
                    "(?:d{1,4}|m{1,4}|y{2,4})(\1?(?:d{1,4}|m{1,4}|y{2,4}))?\b"
        EstFormatDate = .test(nbF)
    End With
End Function

voila tu a un vrai test
et la le numberformat d'obfuscation "jedorsdebout" renverra false

 

[Dudu2]

Voilà le code ChatGPT de @sylvanu corrigé des quotes et backslashes. Suis pas mécontent de lui en mettre une petite à ChatGPT 😎

'---------------------------------------------------
'Returns True if the Cell format is of any Date type
'---------------------------------------------------
Function IsDateFormat(Cell As Range) As Boolean
    Dim CellNumberFormat As String
    Dim CellCleanNumberFormat As String
    Dim OnQuote As Boolean
    Dim iQuote As Integer
    Dim iBackSlash As Integer
    Dim i As Integer
 
    CellNumberFormat = LCase(Cell.NumberFormat)
 
    i = 1
    iQuote = 0
    iBackSlash = -1
 
    For i = 1 To Len(CellNumberFormat)
        'Quote
        If Mid(CellNumberFormat, i, 1) = """" Then
            OnQuote = Not OnQuote
            iQuote = i
        End If
   
        If Mid(CellNumberFormat, i, 1) = "\" Then
            iBackSlash = i
        End If
   
        If Not OnQuote And Not iQuote = i Then
            If Not iBackSlash = i And Not iBackSlash = i - 1 Then
                CellCleanNumberFormat = CellCleanNumberFormat & Mid(CellNumberFormat, i, 1)
            End If
        End If
    Next i
 
    If InStr(CellCleanNumberFormat, "d") > 0 Or InStr(CellCleanNumberFormat, "m") > 0 Or InStr(CellCleanNumberFormat, "y") > 0 Then
        'Return Value
        IsDateFormat = True
    End If
End Function

Et le fichier avec le code de @patricktoulon à la Pattern de l'espace uniquement pour comparaison.