Saisir une date sans les "/" qui se convertisse en jj/mm/aaa

Bonjour à toutes et à tous,

J'ai créé un formulaire comptant de nombreux champs de dates. Afin de fluidifier la saisie, j'aimerais que l'utilisateur puisse la saisir sans les "/" et que ceux-ci apparaissent automatiquement au moment de la validation de la saisie.

Par exemple, si je saisis 15032016, lorsque j'appuie sur entrée, il devient 15/03/2016

A noter, j'ai paramétré une validation de données sur ces cases de façon à ce que ces dates aient systématiquement le même format.

En dépit de mes recherches je n'ai point trouvé de littérature sur le sujet, pouvez-vous éclairer ma lanterne ?

Merci d'avance !

Bonjour,

une idée, avec la condition que l'utilisateur saisisse bien 8 chiffres sans espace (non contrôlé dans le code ci-dessous) :

sub ajout_car_for_date ()

dim a as string
dim b as string
dim col as long
dim li as long

li=1       'numéro de ligne de la cellule à traiter
col=1    'numéro de colonne de la cellule à traiter

a=cells(li, col)
if len(a)<>8 then
      msgbox "La saisie de votre date ne peut pas être traitée.", vbinformation
      exit sub
  end if
b=left(a,2) & "/" & mid(a,3,2) & "/" & right(a,4)
cells(li,col)=b

end sub

je ne l'ai pas testé, mais suis confiant...

Salut ANW, Thihii,

une première version pour des utilisateurs attentifs!

Une deuxième suivra avec les vérifications de validité de la date encodée! 8)

Private Sub txtDate_Change()
'
sTxt = Me.txtDate.Text
If Len(sTxt) = 3 Or Len(sTxt) = 6 Then Exit Sub
'
If IsNumeric(Right(sTxt, 1)) Then
    If Len(sTxt) = 2 Or Len(sTxt) = 5 Then Me.txtDate.Text = sTxt & "/"
Else
    If Len(sTxt) <= 1 Then
        Me.txtDate.Text = ""
    Else
        Me.txtDate.Text = Left(sTxt, Len(sTxt) - 1)
    End If
End If
'
End Sub

A+

Bonsoir curulis57,

ingénieux...

Re,

une version avec saisies dans la colonne [ DATE ] d'un tableau, et possibilité de choisir un séparateur comme :

- 02/05/2016

- 02.05.2016

- 02-05-2016

- 02 05 2016

Bonsoir ANW,

Bonsoir le forum,

@Thihii merci pour l'appréciation!

Une version avec correction des bê..., euh, des distractions des utilisateurs!

Private Sub txtDate_Change()
'
sTxt = Me.txtDate.Text
Select Case Len(sTxt)
    Case 3, 6
        Exit Sub
    Case 10
        iFlag1 = Val(Mid(sTxt, 4, 2))
        If iFlag1 > 12 Then
            MsgBox "Une année ne compte que 12 mois!", vbCritical, "Date"
            Me.txtDate = ""
            Exit Sub
        Else
            If iFlag1 = 2 And Val(Right(sTxt, 4)) Mod 4 > 0 And Val(Left(sTxt, 2)) > 28 Then
                MsgBox "Le mois de FEVRIER d'une année non-bissextile ne compte que 28 jours!", vbCritical, "Date"
                Me.txtDate = "28" & Right(sTxt, 8)
                Exit Sub
            End If
        End If
        iFlag2 = Val(Left(sTxt, 2))
        iLen = Choose(iFlag1, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
        If iFlag1 <> 2 And iFlag2 > iLen Then
            sFlag1 = Choose(iFlag1, "JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOÛT", "SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE")
            sFlag2 = IIf(iFlag1 = 8 Or iFlag1 = 10, "Le mois d'", "Le mois de ")
            MsgBox sFlag2 & sFlag1 & " ne compte que " & iLen & " jours!", vbCritical, "Date"
            Me.txtDate = iLen & Right(sTxt, 8)
        End If
    Case Else
        If IsNumeric(Right(sTxt, 1)) Then
            If Len(sTxt) = 2 Or Len(sTxt) = 5 Then Me.txtDate.Text = sTxt & "/"
        Else
            If Len(sTxt) <= 1 Then
                Me.txtDate.Text = ""
            Else
                Me.txtDate.Text = Left(sTxt, Len(sTxt) - 1)
            End If
        End If
End Select
'
End Sub

A+

Re,

pour jouer le jeu jusqu'au bout avec notre camarade Thihii une version où l'utilisateur choisit le séparateur comme il l'entend de saisie en saisie! 8)

• le premier caractère encodé sera le séparateur !
• donc, taper '/' reviendra à une situation classique!

Pour le plaisir du code!

A+

Re curulis57, et tout le monde,

magnifique. Cela va enrichir ma curiosité, et peut-être de beaucoup d'autres internautes...

j'ai réussi à saisir le 30-02-2016 sans message d'erreur ?

La gestion des dates est corsée, je regarde mieux jeudi, car demain je serais absent.

bonne journée.

Merci Thihii,

obnubilé par les non-bissextiles, j'ai zappé les autres!

J'en ai profité pour réduire l'embonpoint de la procédure!

Private Sub txtDate_Change()
'
Application.EnableEvents = False
'
sTxt = Me.txtDate.Text
Select Case Len(sTxt)
    Case 1, 2, 4, 5, 7, 8, 9
        If IsNumeric(Right(sTxt, 1)) Then
            If Len(sTxt) = 2 Or Len(sTxt) = 5 Then Me.txtDate.Text = IIf([AAA1] <> "", sTxt & [AAA1], sTxt & "/")
        Else
            If Len(sTxt) = 1 Then [AAA1] = sTxt
            If Len(sTxt) <= 1 Then sTemp = ""
            If Len(sTxt) > 1 Then sTemp = Left(sTxt, Len(sTxt) - 1)
            Me.txtDate.Text = sTemp
        End If
    Case 10
        iFlag1 = Val(Mid(sTxt, 4, 2))
        iFlag2 = Val(Left(sTxt, 2))
        If iFlag1 > 12 Then
            MsgBox "Une année ne compte que 12 mois!", vbCritical, "Date"
            Me.txtDate.Text = ""
        Else
            If iFlag1 = 2 Then
                If Val(Right(sTxt, 4)) Mod 4 > 0 And iFlag2 > 28 Then
                    iLen = 28: sTemp = "non-bissextile"
                End If
                If Val(Right(sTxt, 4)) Mod 4 = 0 And iFlag2 > 29 Then
                    iLen = 29: sTemp = "bissextile"
                End If
                If iLen > 0 Then MsgBox "Le mois de FEVRIER d'une année " & sTemp & " ne compte que " & iLen & " jours!", vbCritical, "Date"
            Else
                iTemp = Choose(iFlag1, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
                If iFlag2 > iTemp Then
                    iLen = iTemp
                    sFlag1 = IIf(iFlag1 = 4 Or iFlag1 = 8 Or iFlag1 = 10, "Le mois d'", "Le mois de ")
                    sFlag2 = Choose(iFlag1, "JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOÛT", "SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE")
                    MsgBox sFlag1 & sFlag2 & " ne compte que " & iLen & " jours!", vbCritical, "Date"
                End If
            End If
            If iLen > 0 Then Me.txtDate.Text = iLen & Right(sTxt, 8)
        End If
End Select
'
Application.EnableEvents = True
'
End Sub

8)

A+

Bonjour,

curulis, il y a une erreur dans ton contrôle.

Une année est bissextile si les 2 dernier chiffres sont divisible par 4, mais si c'est 00 elle ne l'est que si le siècle l'est également.

2000 était bissextile, 1900 et 2100 non.

Et tu pourrait faire plus court avec une fonction :

Function dateValide(dat)
    Dim d      As Date
    On Error GoTo erreur
    d = DateValue(dat)
    dateValide = True
    Exit Function
erreur:
    dateValide = False
End Function

Sub test()
    Dim s As String
    s = "31/04/2017"
Debug.Print dateValide(s)
    s = "30-04-2017"
Debug.Print dateValide(s)
End Sub

eric

Bonjour à tous,

Merci beaucoup pour ces réponses, j'ai l'embarras du choix , cependant, le code qui semble le plus adapté à mon cas est celui de Thihii et son fichier "modif format date tableau", je ne veux pas passer par des Textbox parce que mon fichier est une interface faite de plusieurs formulaires alimentant un fichier base de données au format excel également, et vu le volume de code que cela supposerait de mettre à jour, je préfère conserver mes champs actuels.

Tous mes champs de saisie sont nommés et c'est pourquoi j'ai supprimé les références de lignes ou de colonnes, cependant, je ne parviens pas à gérer la présence de plusieurs champs dates dans le même onglet.

Illustration avec les champs nommés :

'Date Signature
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim a As String
    Dim b As String
    Dim c As String
    Dim n As Long
    If Target.Count > 1 Then Exit Sub
    If Target <> Range("RECH_Date_signature") Then GoTo suivant
suivant:     If Target <> Range("RECH_Date_reception") Then Exit Sub

    a = Target
    If Len(a) = 0 Then Exit Sub
    If Len(a) <> 8 Then GoTo Message
    For n = 1 To 8
        If Asc(Mid(a, n, 1)) < 48 Or Asc(Mid(a, n, 1)) > 57 Then GoTo Message   'vérification si chiffre ?
    Next n
    c = "/"
    b = Left(a, 2) & c & Mid(a, 3, 2) & c & Right(a, 4)
    Application.EnableEvents = False    'arrèt des évènements
    Cells(Target.Row, Target.Column) = b    'écriture (qui provoque un évènement)
    Application.EnableEvents = True     'ré-actualisation des évènements
    Exit Sub
Message:
    MsgBox "Merci de saisir une date au format JJMMAAAA", vbCritical
End Sub

Sub de()
Application.EnableEvents = True
End Sub

Dans ce cas seul le dernier champ cité fonctionne...

J'ai tenté avec des or, des Goto, en créant une sub pour chaque champ, le même problème se répète à chaque fois... Que faire ?

Merci pour votre aide !!

Bonjour ANW,

très bon choix!

Bonjour Eriiic,

pour préciser tes judicieuses remarques, un siècle, pour être bissextile, doit être divisible par 400 (et non simplement par 4 : ils le sont tous!), mais je suppose que c'est ce que tu voulais dire!

Je connais cette règle et comme les codes que je m'amuse à créer ne seront certainement plus utilisés en 2400 , je n'intègre pas cette vérification quand ce n'est pas nécessaire, même si, c'est vrai, ça ne mangerait pas de pain!

Quant à l'utilisation de DATEVALUE pour la vérification de validité d'une date, je n'y ai pas pensé, n'étant guère à l'aise avec toutes ces fonctions date.

En bon vieux dinosaure de l'informatique j'ai (encore) l'habitude de jouer avec la pure logique pour résoudre des problèmes que les fonctions actuelles résolvent en deux coups de cuiller à pot!

Mais, je vais quand même y jeter un oeil, histoire de comprimer ce code qu'il m'a plu de concocter!

8)

A+

Bonsoir à tous,

me voici de retour,

ANW, dans ta modif ci dessous, le goto suivant 'pique les yeux' et ne sert à rien !

    If Target <> Range("RECH_Date_signature") Then GoTo suivant
suivant:     If Target <> Range("RECH_Date_reception") Then Exit Sub

en ne regardant que la syntaxe et non pas ta fonction, écrit comme ci-dessous, c'est mieux :

    If Target <> Range("RECH_Date_signature") Then
                              If Target <> Range("RECH_Date_reception") Then Exit Sub
                    end if

je lis et étudie le contrôle de date, j'ai une idée, mais la teste avant...

Re,

Sacrée recherche, curulis57, mais plus simple il y a.

l'idée d'eriiic est bonne, j'eux la même, mais avec une codification différente (fichier joint ci-dessous) :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim a As String
    Dim b As String
    Dim c As String
    Dim n As Long
    Dim dt As Date
    If Target.Count > 1 Then Exit Sub
    If Target.Column <> 2 Or Target.Row < 7 Or Target.Row > 30 Then Exit Sub 'vérifie si colonne date OK ?
    a = Target
    If Len(a) = 0 Then Exit Sub
    If Len(a) <> 8 Then GoTo Message
    For n = 1 To 8
        If Asc(Mid(a, n, 1)) < 48 Or Asc(Mid(a, n, 1)) > 57 Then GoTo Message   'vérification si chiffre ?
    Next n
    c = Sheets(2).Cells(Sheets(2).Cells(1, 3), 1)   'lecture du séparateur à utiliser (dans l'onglet 2)
    On Error GoTo Erreur
    dt = CDate(Left(a, 2) & "/" & Mid(a, 3, 2) & "/" & Right(a, 4)) 'si date incohérante, Erreur !
    On Error GoTo 0
    b = Left(a, 2) & c & Mid(a, 3, 2) & c & Right(a, 4)
    Application.EnableEvents = False    'arrèt des évènements
    Cells(Target.Row, Target.Column) = b    'écriture (qui provoque un évènement)
    Application.EnableEvents = True     'ré-actualisation des évènements
    Exit Sub

Message:
    MsgBox "le format de votre date n'est pas conforme pour appliquer un format.", vbInformation
    Exit Sub

Erreur:
    MsgBox "Cette date est invalide, veuillez la vérifier et la modifier.", vbCritical
End Sub

Avec le on error, pas besoin d'utiliser une condition...

Bonjour le forum

Bonjour le fil (même s'il s'est éteint depuis la dernière discussion)

Si je pose la question, c'est que je ne suis parvenu à mes fins. Ne peut on, à partir du code de Thihii, l'exécuter sur une cellule (Target), quelle qu'elle soit dans une feuille bien précise (Worksheet_Change), avec un séparateur (immuable) fixé dès le départ de la procédure. J'ai beau chercher (mes connaissances sont bien maigres...), je ne trouve pas. Je sais faire par format personnalisé mais pas via le Vba.

Remerciements à celles et ceux qui se pencheront sur la question.

Eric