XL 2019 Saisir au format date automatiquement

[pat66]

Bonsoir le forum,

je cherche désespérément une solution qui me permette de saisir dans la cellule K74, par exemple 12102024
et que automatiquement le format dans la cellule affiche 12/12/2024 sans avoir à saisir les parenthèses ou les tirets

Pensez vous que cela soit possible ? merci

pat66

 

[Eric C]

Bonsoir le forum
Bonsoir pat66

Format personnalisé :

## "/" ## "/" ####

Bonne soirée
@+ Eric c

 

[Dudu2]

Bonsoir,
Je ne crois pas qu'un format puisse traduire la valeur en date même si elle en a l'apparence, car dans le meilleur des cas, ça restera un nombre formaté avec des "/" et pas une date au sens Excel.

Il faut passer par du code. Et c'est tout sauf simple:

Private Const CelluleDate = "K74"

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim VarVal As Variant
    Dim StrVal As String
   
    If Intersect(Target, Me.Range(CelluleDate)) Is Nothing Then Exit Sub

    'Pour éviter le dépassement de capacité sur un formt Date
    Me.Range(CelluleDate).NumberFormatLocal = "Standard"
    VarVal = Me.Range(CelluleDate).Value
   
    If IsNumeric(VarVal) Then
        StrVal = Trim(CStr(VarVal))

        Application.EnableEvents = False
        On Error Resume Next
       
        Select Case Len(StrVal)
            Case 6
                Me.Range(CelluleDate).Value = CDate(Mid(StrVal, 1, 1) & "/" & Mid(StrVal, 2, 1) & "/" & Mid(StrVal, 3))
           
            Case 7
                If Left(StrVal, 1) = "0" Then
                    Me.Range(CelluleDate).Value = CDate(Mid(StrVal, 1, 2) & "/" & Mid(StrVal, 3, 1) & "/" & Mid(StrVal, 4))
                Else
                    If CInt(Mid(StrVal, 2, 2)) <= 12 Then
                        Me.Range(CelluleDate).Value = CDate(Mid(StrVal, 1, 1) & "/" & Mid(StrVal, 2, 2) & "/" & Mid(StrVal, 4))
                    Else
                        Me.Range(CelluleDate).Value = CDate(Mid(StrVal, 1, 2) & "/" & Mid(StrVal, 3, 1) & "/" & Mid(StrVal, 4))
                    End If
                End If
           
            Case 8
                Me.Range(CelluleDate).Value = CDate(Mid(StrVal, 1, 2) & "/" & Mid(StrVal, 3, 2) & "/" & Mid(StrVal, 5))
        End Select
       
        On Error GoTo 0
        Application.EnableEvents = True
    End If
End Sub

Edit: A noter que si la conversion en date se passe bien, la cellule retrouve un format Date automatiquement.

 

[Dudu2]

A noter qu'une saisie du type 1112022 peut être traduite de 2 manières:
01/11/2022
11/01/2022
Le code ci-dessus a choisi la 1ère option.

 

[Dranreb]

Bonsoir.
Si on ne va pas jusqu'à permettre l'année à 2 chiffres, on peut quand même faire plus simple :

If Target.Value >= 1011900 Then Target.Value = DateSerial(Target.Value Mod 10000, _
   (Target.Value \ 10000) Mod 100, Target.Value \ 1000000)

 

[Dudu2]

Bonjour,
En effet ça fonctionne mais il faut saisir les 7 ou 8 chiffres.
Ou plus précisément, les 2 chiffres du mois.
En tous cas j'ai appris un truc sur l'opérateur "\" !

 

[Dranreb]

Bonjour.
Avec mon code j'obtiens ces résultats avec ces mêmes frappes :

12/05/2022​

152022​

01/05/2022​

04/10/1992​

À condition toutefois que la cellule ne porte pas déjà un format de date, sinon il essaie d'abord de l'interpréter comme telle, ce qui provoque un dépassement de capacité
Pour limiter le dégât sur une cellule à changer on peut obliger à l'effacer d'abord et prévoir :

Private Sub Worksheet_Change(ByVal Target As Range)
   If IsEmpty(Target.Value) Then
      Target.NumberFormat = "General"
   ElseIf Target.Value >= 1011900 Then
      Target.Value = DateSerial(Target.Value Mod 10000, _
         (Target.Value \ 10000) Mod 100, Target.Value \ 1000000)
      End If
   End Sub

 

[Dudu2]

ce qui provoque un dépassement de capacité

C'est pour ça que je passe la cellule en format "Standard" avant le IsNumeric qui plante en dépassement de capacité en format Date.
De toutes façons, si la date est bonne la cellule repasse automatiquement en format Date.

Il faudrait un test et formatage supplémentaire pour traiter le cas 152022 -> 01/05/2022, soit le cas ou le nombre est < 1.000.000

 

[Dranreb]

Malheureusement c'est dans la fourchette des valeurs de série des date puisque c'est celle du 23/3/2316
Mais peut être peut-on le traiter quand même en testant si c'est bien un double et non une date qui a été saisie sur cellule vide au format standard.

 

[Dudu2]

Version simplifiée:

Private Const CelluleDate = "K74"

Private Sub Worksheet_Change(ByVal Target As Range)
 
    If Intersect(Target, Me.Range(CelluleDate)) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub

    'Pour éviter le dépassement de capacité sur un format Date
    Target.NumberFormat = "General"
    If IsDate(Target.Value) Then Exit Sub
 
    If IsNumeric(Target.Value) Then
        Application.EnableEvents = False
        On Error Resume Next
 
        If Target.Value < 1000000 Then
            '152022 -> 01/05/2022
            Target.Value = DateSerial(Target.Value Mod 10000, (Target.Value \ 10000) Mod 10, Target.Value \ 100000)
        ElseIf Target.Value >= 1011900 Then
            '1052022 -> 01/05/2022
            Target.Value = DateSerial(Target.Value Mod 10000, (Target.Value \ 10000) Mod 100, Target.Value \ 1000000)
        End If
 
        On Error GoTo 0
        Application.EnableEvents = True
    End If
End Sub

Après il y a des chiffres fantaisistes qui donnent aussi des dates mais pour rester simple on ne les contrôle pas.

 

[Dranreb]

Ça n'interdit pas la saisie d'une date normale, ça ? (c'est juste une question). Si oui peut être faut-il d'abord tester If VarTpe(Target.Value) <> vbDate
Ou faire un Select Case VarTpe(Target.Value) et traiter les Case vbEmpty, vbError, vbDouble et vbDate

 

[Dudu2]

Ah ben oui, mais le demandeur ne veut pas saisir de séparateurs.
Sinon on peut laisser passer mais il faut du code.
J'ai modifié le code ci-dessus.

 

[pat66]

Bonsoir le forum, le fil

après plusieurs tests, c'est la formule de Dudu2 qui fonctionne parfaitement pour ma configuration

Un grand merci à tous pour votre aide et à dudu2 en particulier

Pat66

 

[Dudu2]

Cool. Enfin si tu as pris la version simplifiée, c'est surtout du @Dranreb

 

[Eric C]

Bonsoir le fil

Pour ma part, concernant la version simplifiée, je suis obligé de placer la ligne :

  Target.NumberFormatLocal = "Standard"

de suite sous le Private Sub, sinon si je veux modifier la date une erreur "dépassement de capacité" est générée -- Excel 2010
Bonne soirée
@+ Eric c