Saisir une date au format xx/xx/xx

Linoa85 -  
pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   -
Bonjour,

Je souhaiterais formater une textbox, pour faire apparaitre une date.
Voilà ce que j'ai :
Private Sub TextBox4_Change()
'exemple pour format xx/xx/xxxx
Dim Valeur As Byte
TextBox4.MaxLength = 10
Valeur = Len(TextBox4)
If Valeur = 2 Or Valeur = 5 Then TextBox4 = TextBox4 & "/"
End Sub

Je voudrais également obliger l'utilisateur à saisir 10 chiffres, et uniquement des chiffres...
Avec cette formulation j'ai bien les / qui se mette mais je peux mettre du texte et ne renseigner que 2,3,4... chiffres !!!

Merci d'avance de votre aide,

10 réponses

  1. Linoa85
     
    Malheureusement non.
    En effet la demande est de mettre après coup les /
    Et cela ne limite pas la saisie..
    0
  2. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    Bonjour Linoa85, Melanie1324,

    Pour limiter la saisie, il faut contrôler chaque caractère entré dans le textbox. Pour cela, il te faut utiliser d'autres événements que TextBox4_Change().

    Regarde déjà cette discussion et reviens en cas de souci :
    https://codes-sources.commentcamarche.net/forum/oldest/10059886-textebox-en-forme-date

    Avant, j'arrivais jamais à finir mes phrases... mais maintenant je
    0
  3. Linoa85
     
    Le lien ne fonctionne pas.
    Désolé mais je suis vraiment débutante...
    0
    1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      Je viens de le modifier, il fonctionne.
      0
  4. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  5. melanie1324 Messages postés 1561 Statut Membre 156
     
    Re,

    Voici ce que je te propose :

    Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean) 
    If Not IsDate(TextBox4) Then 
    Cancel = True 
    End If 
    End Sub


    ==> à la sortie du champ, on va vérifier si la valeur est une date (donc 10 chiffres).
    Si ce n'est pas une date, le curseur restera bloqué sur le champ jusqu'à ce que ce soit une date .
    0
    1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      Salut Melanie,

      Cette solution n'est pas complète.
      En effet, elle accepte, par exemple : 12/11/2
      0
  6. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    Bonjour,

    Si tu le souhaites, je peux t'apporter une réponse globale pour tous tes textbox spécifiques.
    Il faudrait, avant cela, que tu listes les particularités de saisie de tes textbox.

    Voici un exemple de ce que tu peux souhaiter :
    > TextBox "dates" => format : jj/mm/aaaa (ou tout autre format),
    > TextBox "Heures" => format hh:mm:ss (ou tout autre format),
    > TextBox "Sécurité sociale" => 15 chiffres, pas plus, pas moins, pas d'autre caractère,
    > TextBox "NOM" => que des caractères alphabétiques, avec (ou sans) accents, en majuscule, trait d'union autorisé, pas d'espace,
    > TextBox "Prénom" => que des caractères alphabétiques, avec (ou sans) accents, majuscule sur la première lettre, trait d'union autorisé, pas d'espace,
    > TextBox "adresse IP" : formatage obligatoire : xxx.xxx.xxx.xxx ou chaque xxx représentent en nombre compris entre 000 et 255,
    > TextBox "code postal" : 4 ou 5 chiffres, et que des chiffres,
    > etc, etc...

    Dans l'attente de ta réponse.
    0
  7. Linoa85
     
    Bonjour,

    Oui effectivement j'ai plusieurs textbox à "formater"
    Donc date, et sécurité sociale. Pour les autres j'ai déjà trouvé...

    Après avoir réfléchi avec les réponses de chacun, je souhaiterais savoir comment obtenir une "> TextBox "Sécurité sociale" => 15 chiffres, pas plus, pas moins, pas d'autre caractère, "

    Et ensuite pour les dates (j'ai exactement 3 texteboxs) faire une vérification mais en fin.

    Pour essayer d'être clair voilà déjà ce que j'ai fait :

    Private Sub TextBox1_Change()
    On Error Resume Next
    If Len(TextBox1) = 15 Then
    TextBox1 = Left(TextBox1, 15)
    Exit Sub
    End If
    If Not IsNumeric(Right(TextBox1, 1)) Then
    MsgBox "Saisir des caractères numériques uniquement"
    TextBox1 = Left(TextBox1, Len(TextBox1) - 1)
    End If
    End Sub

    Private Sub TextBox2_Change()
    'mettre le texte en majuscule
    Dim A As Variant
    A = Me.TextBox2
    A = UCase(A)
    Me.TextBox2 = A

    End Sub

    Private Sub TextBox3_Change()
    'mettre la premiere lettre en majuscula
    If Len(TextBox3) = 1 Then TextBox3 = UCase(TextBox3)
    End Sub

    Private Sub TextBox4_Change()
    'exemple pour format xx/xx/xxxx
    Dim Valeur As Byte
    TextBox4.MaxLength = 10

    Valeur = Len(TextBox4)
    If Valeur = 2 Or Valeur = 5 Then TextBox4 = TextBox4 & "/"

    End Sub

    Private Sub TextBox5_Change()
    'exemple pour format xx/xx/xxxx
    Dim Valeur As Byte
    TextBox5.MaxLength = 10

    Valeur = Len(TextBox5)
    If Valeur = 2 Or Valeur = 5 Then TextBox5 = TextBox5 & "/"

    End Sub

    Private Sub ok_Click()

    Dim X As Boolean
    Dim i As Byte
    Dim dernlign As Long
    Dim result As String

    ' vérification si textbox vides

    For i = 1 To 6
    If Me.Controls("TextBox" & i) = "" Then
    X = True
    End If
    Next i

    For i = 1 To 5
    If Me.Controls("Combobox" & i) = "" Then
    X = True
    End If
    Next i

    'message si une ou plusieurs sont vides
    If X = True Then
    MsgBox "Veuillez remplir tous les champs"
    Else: Sheets("agents").Select
    dernlign = (Range("A" & Rows.Count).End(xlUp).Row) + 1
    Range("a" & dernlign).Value = TextBox1.Value
    Range("b" & dernlign).Value = TextBox2.Value
    Range("c" & dernlign).Value = TextBox3.Value
    Range("d" & dernlign).Value = ComboBox1.Value
    Range("e" & dernlign).Value = TextBox4.Value
    Range("g" & dernlign).Value = ComboBox2.Value
    Range("h" & dernlign).Value = TextBox5.Value
    Range("i" & dernlign).Value = TextBox6.Value
    Range("m" & dernlign).Value = TextBox7.Value
    Range("l" & dernlign).Value = ComboBox4.Value
    Range("n" & dernlign).Value = ComboBox5.Value
    If ComboBox2.Value = "CDD" Then Call cdd
    If CheckBox1 = True Then
    Range("w" & dernlign).Value = "X"
    End If

    Range("A" & dernlign).Select
    Unload UserForm1
    result = MsgBox("Agent créé avec succès" & Chr(10) & Chr(10) & "Voulez-vous créer une nouvelle entrée?", vbYesNo)
    If result = vbYes Then
    UserForm1.Show
    End If

    End If

    End Sub

    Private Sub UserForm_initialize()
    With Me.ComboBox5
    .AddItem "50"
    .AddItem "80"
    .AddItem "90"
    .AddItem "100"
    End With

    With Me.ComboBox1
    .AddItem "Madame"
    .AddItem "Monsieur"
    End With

    End Sub

    Private Sub cdd()
    Sheets("Renouvellement").Select
    dernlign = (Range("A" & Rows.Count).End(xlUp).Row) + 1
    Range("A" & dernlign).Value = TextBox1.Value
    Range("b" & dernlign).Value = TextBox2.Value
    Range("c" & dernlign).Value = TextBox2.Value
    Range("d" & dernlign).Value = ComboBox3.Value
    Range("e" & dernlign).Value = TextBox5.Value
    Range("f" & dernlign).Value = TextBox6.Value
    Range("A" & dernlign).Select
    Sheets("AGENTS").Select
    End Sub
    0
    1. melanie1324 Messages postés 1561 Statut Membre 156
       
      bonjour,

      concernant les 15 chiffres de la sécu sociale :

      ne mets pas :

      Private Sub TextBox1_Change()
      On Error Resume Next
      If Len(TextBox1) = 15 Then
      TextBox1 = Left(TextBox1, 15)
      Exit Sub
      End If
      If Not IsNumeric(Right(TextBox1, 1)) Then
      MsgBox "Saisir des caractères numériques uniquement"
      TextBox1 = Left(TextBox1, Len(TextBox1) - 1)
      End If
      End Sub

      mais :

      Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

      If Not IsNumeric(TextBox1) Then
      MsgBox "Saisir des caractères numériques uniquement"
      cancel = True
      else
      If Len(TextBox1) <> 15 Then
      MsgBox "Merci de saisir 15 caractères"
      cancel = True
      End If
      End If
      End Sub
      0
      1. Linoa85 > melanie1324 Messages postés 1561 Statut Membre
         
        Je vais tenter...
        0
    2. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      Tes tests ne suffisent pas.
      Aucun ne garanti une bonne saisie.

      TextBox1 = sécurité sociale => accepte la sortie avec 3 caractères
      TextBox2 = NOM => accepte des chiffres
      TextBox3 = Prénom => accepte des chiffres
      TextBox4 = Date => accepte 56/24/2016 comme date...
      TextBox5 = Date => cf TextBox4

      C'est pourquoi, je renouvelle ma question, décris moi tous tes besoins précisément.
      0
  8. Linoa85
     
    Là j'ai besoin :

    TextBox1 = sécurité sociale => 15 chiffres, pas plus, pas moins, pas d'autre caractère
    TextBox2 = NOM => Uniquement des lettres en majuscules
    TextBox3 = Prénom => Là encore uniquement des lettres avec la première en majuscule
    TextBoxS = Date => Un vrai format date (donc entre le 01 et le 31 pour le jour, entre 1 et 12 pour le mois...) + uniquement des chiffres + entre 8 et 10 caractères

    Peut être sans "formater" toutes les textboxs mais en faisant une vérification lors du click final...
    0
    1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      Autant t'alerter tout de suite. Un format de date à 8 caractères ne devrait plus être utilisé.
      A quoi correspond la date : 19/02/39 ???
      A mon avis, tant qu'à "forcer" le format, autant obtenir des données exploitables...
      0
      1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773 > pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention  
         
        Pour les 2 et 3 as tu besoin d'accents?
        0
      2. Linoa85 > pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention  
         
        Pour les 2 et 3 non pas nécessairement, mais cela ne me dérange pas...
        Pour la date tu as raison, comme excel met systémtiquement le 19 ou 20 devant
        0
  9. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    Dans l'attente des réponses, voici un premier jet :
    > Sans accents
    > Le format date à 10 chiffres uniquement
    ==> barre d'espace en "premier caractère" = date du jour

    Option Explicit
    
        'TEXTBOX1 = Sécurité sociale
        Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
            If Len(TextBox1) <> 15 Then Cancel = True
        End Sub
    
        Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
            If Len(TextBox1.Text) = 15 And KeyCode <> 46 And KeyCode <> 8 Then KeyCode = 0: Exit Sub
            Select Case KeyCode
                Case 96 To 105  'chiffres pavé numérique
                    If Shift = 1 Then KeyCode = 0
                Case 48 To 57   'chiffre touches clavier alphanumérique
                    If Shift = 0 Then KeyCode = 0
                Case 8, 9, 16, 46  'touches retour arrière, TAB, Shift, Suppr
                    'action à voir
                Case Else
                    KeyCode = 0
            End Select
        End Sub
    
        'TEXTBOX2 = NOM
        Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
            If TextBox2.Text = "" Then Cancel = True
        End Sub
    
        Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
            Select Case KeyAscii
                Case 32 'espace
                    KeyAscii = 0
                Case 45  'trait d'union
                    If Len(TextBox2.Text) = 0 Then KeyAscii = 0
                Case 65 To 90 'majuscules
                Case 97 To 122 'minuscules
                    KeyAscii = KeyAscii - 32
                Case Else
                    KeyAscii = 0
            End Select
        End Sub
    
        'TEXTBOX3 = Prenom
        Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
            If TextBox3.Text = "" Then Cancel = True
        End Sub
        
        Private Sub TextBox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
            Select Case KeyAscii
                Case 32 'espace
                    KeyAscii = 0
                Case 45  'trait d'union
                    If Len(TextBox3.Text) = 0 Then KeyAscii = 0
                Case 65 To 90 'majuscules
                    If Len(TextBox3.Text) > 0 Then KeyAscii = 0
                Case 97 To 122 'minuscules
                    If Len(TextBox3.Text) = 0 Then KeyAscii = KeyAscii - 32
                Case Else
                    KeyAscii = 0
            End Select
        End Sub
        
        'TEXTBOX4 = Date
        Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
            If TextBox4.Text <> "" And Len(TextBox4.Text) < 10 Then
                Cancel = True
            Else
                If TextBox4.Text <> "" Then TextBox4.Tag = TextBox4.Text
            End If
        End Sub
    
        Private Sub TextBox4_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
            teste_date ActiveControl, KeyCode, "##/##/####", False
        End Sub
        
        'TEXTBOX5 = Date
        Private Sub TextBox5_Exit(ByVal Cancel As MSForms.ReturnBoolean)
            If TextBox5.Text <> "" And Len(TextBox5.Text) < 10 Then
                Cancel = True
            Else
                If TextBox5.Text <> "" Then TextBox5.Tag = TextBox5.Text
            End If
        End Sub
    
        Private Sub TextBox5_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
            teste_date ActiveControl, KeyCode, "##/##/####", False
        End Sub
        
        
        '-----------------------------------------------------------------
        'http://codes-sources.commentcamarche.net/forum/oldest/10059886-textebox-en-forme-date#14
        Private Sub teste_date(ByRef t As MSForms.TextBox, ByRef cod As MSForms.ReturnInteger, ByVal flt As String, scl As Boolean)
        Dim ici As Byte, sp As String, cr As String, drf As String, dtt As String, siecle As Boolean
            sp = Left(Replace(flt, "#", ""), 1)
            drf = "31" & sp & "12" & sp & "2000" 'ne touche jamais rien à cette chaine
            With t
                ici = .SelStart
                If cod = 46 And .SelText = Mid(.Text, ici + 1) Then
                    .Text = Left(.Text, ici)
                    If Len(.Text) = 2 Or Len(.Text) = 5 Then .Text = Left(.Text, Len(.Text) - 1)
                    cod = 0: Exit Sub
                End If
                If ici < Len(.Text) Then .SelStart = Len(.Text): cod = 0: Exit Sub
                If cod = 8 Then
                    If ici = 3 Or ici = 6 Then .Text = Left(.Text, Len(.Text) - 1)
                    Exit Sub
                End If
                If cod = 37 And ici = 0 Then
                    If IsDate(.Tag) Then .Text = .Tag: cod = 0: Exit Sub
                End If
                If cod > 95 Then cr = Chr(cod - 48)
                If ici = 3 Then Mid(drf, 1, 5) = IIf(cr = "0", "00" & sp & "01", "00" & sp & "02")
                dtt = .Text & cr & Mid(drf, ici + 2)
                If cod = 32 Then
                    If ici = 0 Or ici = 3 Or ici = 6 Or ici = 8 Then
                        Dim voir As String
                        voir = .Text & Mid(Format(Date, "dd" & sp & "mm" & sp & "yyyy"), ici + 1)
                        If IsDate(voir) Then .Text = voir
                    End If
                    cod = 0:   Exit Sub
                End If
                If ici <> 8 Then
                    If Not IsDate(dtt) Or Not dtt Like flt Then cod = 0: Exit Sub
                Else
                    If Not IsNumeric(cr) Then cod = 0: Exit Sub
                End If
                Select Case ici
                    Case 1, 4
                        If ici = 4 And Val(Mid(.Text, ici, 1) & cr) > 12 Then cod = 0: Exit Sub
                        If ici = 4 And scl Then
                            .Text = Left(dtt, Len(.Text & cr)) & sp & Int(Year(Date) / 100): cod = 0
                        Else
                            .Text = Left(dtt, Len(.Text & cr)) & sp: cod = 0
                        End If
                    Case 3
                        If cr > "1" Then cod = 0
                End Select
            End With
            Application.CutCopyMode = True
        End Sub

    Avant, j'arrivais jamais à finir mes phrases... mais maintenant je
    0
    1. Linoa85
       
      Bonjour,

      Je viens de me rendre compte que j'ai un problème avec ce code.
      En effet quand je rentre une date type 04/01/2016 cela me met dans le cellule 01/04/2016.

      J'ai essayé de bidouiller mais j'avoue que je ne suis pas une experte !

      En tout cas j'utilise ton code, et je t'en remercie 1000 fois
      0
    2. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773 > Linoa85
       
      Bonjour,

      Dans le code de ton bouton, utilise Format, comme ceci :

      maCellule.Value = Format(TextBox5, "yyyy/mm/dd")

      et formate correctement tes cellules (Clic droit/format de cellule)
      0
    3. Linoa85
       
      Le code du bouton ?
      Désolé je suis une vraie novice
      0
    4. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773 > Linoa85
       
      cela me met dans le cellule
      Comment cela te met-il le résultat dans une cellule?
      Quel est le code que tu utilises pour transférer de l'Userform vers ta feuille?
      0
    5. Linoa85
       
      Voilà le code pour 1/ vérifier puis copier les éléments :
      Private Sub ok_Click()

      Dim X As Boolean
      Dim i As Byte
      Dim dernlign As Long
      Dim result As String

      ' vérification si textbox vides
      For i = 1 To 5
      If Me.Controls("TextBox" & i) = "" Then
      X = True
      End If
      Next i
      For i = 1 To 5
      If Me.Controls("Combobox" & i) = "" Then
      X = True
      End If
      Next i

      'message si une ou plusieurs sont vides
      If X = True Then
      MsgBox "Veuillez remplir tous les champs"
      Else: Sheets("agents").Select
      dernlign = (Range("A" & Rows.Count).End(xlUp).Row) + 1
      Range("a" & dernlign).Value = TextBox1.Value
      Range("b" & dernlign).Value = TextBox2.Value
      Range("c" & dernlign).Value = TextBox3.Value
      Range("d" & dernlign).Value = ComboBox1.Value
      Range("e" & dernlign).Value = TextBox4.Value
      Range("g" & dernlign).Value = ComboBox2.Value
      Range("h" & dernlign).Value = TextBox5.Value
      Range("i" & dernlign).Value = TextBox6.Value
      Range("m" & dernlign).Value = ComboBox3.Value
      Range("l" & dernlign).Value = ComboBox4.Value
      Range("n" & dernlign).Value = ComboBox5.Value
      Range("o" & dernlign).Value = TextBox8.Value
      Range("q" & dernlign).Value = TextBox9.Value
      If ComboBox2.Value = "CDD" Then Call cdd


      Range("A" & dernlign).Select
      Unload UserForm1
      result = MsgBox("Agent créé avec succès" & Chr(10) & Chr(10) & "Voulez-vous créer une nouvelle entrée?", vbYesNo)
      If result = vbYes Then
      UserForm1.Show
      End If

      End If

      End Sub
      0
  10. Linoa85
     
    Super merci beaucoup !!

    Pour le textbox SS : je ne peux pas passer aux autres textboxs avec mon clavier

    Et je me permets également une nouvelle question (je veux apprendre !!!) :
    Etant donné que j'ai 3 textbox avec des dates, je ne pourrais pas plutôt faire une fonction ?

    Comme en math un peu
    Si X = non numérique
    Si X ≠ 10 caractères
    Alors = message d'erreur ou impossibilité de passer à la suivante

    x = textbox4 et textbox5 et textbox6
    0
    1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      Pour le textbox SS : je ne peux pas passer aux autres textboxs avec mon clavier
      Non. Ni avec la souris...
      C'est impossible tant qu'il n'y a pas 15 chiffres de saisi. C'était le but de ta demande.

      Etant donné que j'ai 3 textbox avec des dates, je ne pourrais pas plutôt faire une fonction ?
      Ben elle y est la fonction...
      Private Sub teste_date

      Que tu appelles dans chaque textbox "dates" comme ceci :
          Private Sub TextBox5_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
              teste_date ActiveControl, KeyCode, "##/##/####", False
          End Sub


      Il faut également ajouter l'événement Exit pour empêcher la sortie.
      0
      1. Linoa85 > pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention  
         
        Même lorsque je rentre mes 15 chiffres je ne peux pas aller au suivante via le clavier
        0
      2. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773 > Linoa85
         
        Ah oui tiens...
        Oups!
        Remplace :
        Private Sub TextBox1_KeyDown

        par :
            Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
                Select Case KeyCode
                    Case 96 To 105  'chiffres pavé numérique
                        If Shift = 1 Then KeyCode = 0
                        If Len(TextBox1.Text) = 15 Then KeyCode = 0
                    Case 48 To 57   'chiffre touches clavier alphanumérique
                        If Shift = 0 Then KeyCode = 0
                        If Len(TextBox1.Text) = 15 Then KeyCode = 0
                    Case 8, 9, 16, 46  'touches retour arrière, TAB, Shift, Suppr
                        'action à voir
                    Case Else
                        KeyCode = 0
                End Select
            End Sub
        0