Saisir une date au format xx/xx/xx

Linoa85 -  
pijaku Messages postés 12263 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,
A voir également:

10 réponses

Réponse 1 / 10
melanie1324 Messages postés 1504 Date d'inscription   Statut Membre Dernière intervention   155
 
bonjour,

rregarde si la solution donnée iici peut t'aider :

https://forums.commentcamarche.net/forum/affich-2027062-vba-format-de-date-dans-textbox
1
Réponse 2 / 10
Linoa85
 
Malheureusement non.
En effet la demande est de mettre après coup les /
Et cela ne limite pas la saisie..
0
Réponse 3 / 10
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
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
Réponse 4 / 10
Linoa85
 
Le lien ne fonctionne pas.
Désolé mais je suis vraiment débutante...
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Je viens de le modifier, il fonctionne.
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 10
melanie1324 Messages postés 1504 Date d'inscription   Statut Membre Dernière intervention   155
 
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
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Salut Melanie,

Cette solution n'est pas complète.
En effet, elle accepte, par exemple : 12/11/2
0
Réponse 6 / 10
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
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
Réponse 7 / 10
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
melanie1324 Messages postés 1504 Date d'inscription   Statut Membre Dernière intervention   155
 
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
Linoa85 > melanie1324 Messages postés 1504 Date d'inscription   Statut Membre Dernière intervention  
 
Je vais tenter...
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
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
Réponse 8 / 10
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
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
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
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761 > pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention  
 
Pour les 2 et 3 as tu besoin d'accents?
0
Linoa85 > pijaku Messages postés 12263 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
Réponse 9 / 10
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
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
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
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761 > 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
Linoa85
 
Le code du bouton ?
Désolé je suis une vraie novice
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761 > 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
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
Réponse 10 / 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
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
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
Linoa85 > pijaku Messages postés 12263 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
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761 > 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

Discussions similaires

Si "xx" ou "yy" alors
Ludivine -
Ludivine -

2 réponses
xx
le travailliste -
babacool-13 -

3 réponses
viadeo
summer -
lou -

10 réponses
Toutes les lignes contenant xxx dans la colonne xx OU yy
TargetSelected -
TargetSelected -

8 réponses
Recherche musique type intro the XX
Celia111 -
Celia111 -

10 réponses