Autres Fonction Date dans TextBox

[Nonomix]

Bonjour,

J'ai un tableau réaliser sous Excel 2007 avec un formulaire avec une TextBox que je voudrais au format date.

Actuellement je suis obliger de rentrer au format 01/02/2020 (pour 1 février 2020) mais cela me mets dans la cellule 02/01/2020 (pour 2 janvier 2020) ce qui correspond pas du tout a mon souhait.

J'aimerais qu'on puisse saisir au choix 01/02/2020 ou 01.02.2020 ou 01022020 et que cela me copie dans la cellule final A1 au format jj/mm/aaaa. La cellule A2 comprend la formule =A1 mais doit être au format exclusif mmm-aa (car actuellement cela mets au format identique que A1 malgré la configuration format cellule mmm-aa)

Merci pour votre aide.

 

[Nonomix]

Re,

Je viens de trouvé l'erreur pour la date qui voulais pas se mettre dans la cellule.
Par contre je comprend pas pourquoi cela me ferme le formulaire quand la date saisie n"est pas bonne malgré le message que la date saisie est incorrect.

 

[Nonomix]

bonjour
je l'ai donné moult fois pourtant la solution du textbox date forcée avec control de validité dynamique
il y a un moteur de recherche dans le site

Option Explicit

Const separator As String = "/"
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    ControlValiddate TextBox1, KeyAscii
End Sub

Private Sub ControlValiddate(txtb, KeyAscii)
    Dim t$
    With txtb
        If Not Chr(KeyAscii) Like "*[0-9]*" Then KeyAscii = 0
        t = Mid(.Value, 1, .SelStart)
        If Len(t) = 2 Or Len(t) = 5 Then t = t & separator
        t = t & Chr(KeyAscii):
        If Len(t) >= 6 Then If Not IsDate(Left(t, 6) & "2000") Then t = Left(t, 3): Beep
        If Len(t) = 10 And Not IsDate(t) Then t = Left(t, 6): Beep
        .Value = Mid(t, 1, 10)
        If Val(.Value) > 31 Then .Value = "": Beep
    End With
    KeyAscii = 0
End Sub

et si il fllait aller un peu plus loin avec par exemple un masque de saisie et la gestion des 3 format de date géré nativement par vba tu a ceci aussi

Collection textbox formatés(patricktoulon)Un DateBox avec masque de saisie

Bonjour a tous je vous propose ma fonction qui transforme un TextBox en Date Box pour les 3 formats principaux il vous est impossible de taper une date erronée la gestion d'erreur re sélectionne le segment de la chaîne tapée qui est une...

www.excel-downloads.com

faut il encore ce donner la peine de chercher

pour info dans l'exemple ici présenté et la ressource du lien les touches suppr et back ne sont pas condamnées

Je commence tout juste la bva, et ce que tu m'as donnée est encore du chinois pour moi

La formule de mapomme est plus simple pour moi, en tout cas pour le moment sauf peut être le détail que mon formulaire se ferme que la date soit bonne ou non.

 

[mapomme]

Re @patricktoulon ,

Sauf erreur de ma part, en quoi ton code empêche-t-il de rentrer des dates inexistantes (par exemple 12/24/20) ?

 

[patricktoulon]

re @mapomme
parce qu'il gère le format dd/mm/yyyy ou mm/dd/yyyyy
après si tu t’arrête a "20" de taper ta date vba ne peut pas le deviner
maintenant si tu veux je peux te le contraindre au format FR si tu veux

 

[Nonomix]

Re @patricktoulon ,

Sauf erreur de ma part, en quoi ton code empêche-t-il de rentrer des dates inexistantes (par exemple 12/24/20) ?

C'est ce que j'essaye de comprendre pourquoi

Dans le tableau de mapomme, la tabulation se fait entre les 3 TextBox et il y a un message d'erreur qui indique que la date est pas bonne, on fait OK et le formulaire reste.

Dans mon tableau je n'est pas la tabulation et j'ai bien un message d'erreur qui indique que la date est pas bonne, on fait OK mais le formulaire se ferme,

 

[patricktoulon]

re
@mapomme
format FR forcé

Private Sub ControlValiddate(txtb, KeyAscii)
    Dim t$
    With txtb
        If Not Chr(KeyAscii) Like "*[0-9]*" Then KeyAscii = 0
        t = Mid(.Value, 1, .SelStart)
        If Len(t) = 2 Or Len(t) = 5 Then t = t & separator
        t = t & Chr(KeyAscii):
        If Len(t) >= 5 Then If Val(Mid(t, 4, 2)) > 12 Then t = Left(t, 3): Beep
       If Len(t) >= 6 Then If Not IsDate(Left(t, 6) & "2000") Then t = Left(t, 3): Beep
         If Len(t) = 10 And Not IsDate(t) Then t = Left(t, 6): Beep
        .Value = Mid(t, 1, 10)
        If Val(.Value) > 31 Then .Value = "": Beep
    End With
    KeyAscii = 0
End Sub

 

[mapomme]

parce qu'il gère le format dd/mm/yyyy ou mm/dd/yyyyy
après si tu t’arrête a "20" de taper ta date vba ne peut pas le deviner
maintenant si tu veux je peux te le contraindre au format FR si tu veux

C'est bien ce que j'ai dit plus haut: on ne peut pas se fier à CDATE() (ni à ISDATE() ) pour éviter de rentrer des dates erronées.

 

[Nonomix]

Voici mes codes du CommandButton

Private Sub CommandButton1_Click()
        If TextBox1 = "" Then MsgBox "Saisir le prénom de l'enfant.": Exit Sub
        If TextBox2 = "" Then MsgBox "Saisir le nom de l'enfant.": Exit Sub
        If TextBox4 = "" Then MsgBox "Saisir le nom de la feuille.": Exit Sub
    Sheets("FEUILLE TYPE A COPIER").Copy After:=Sheets("RECAP")
    Worksheets("FEUILLE TYPE A COPIER (2)").Visible = True
    Sheets("FEUILLE TYPE A COPIER (2)").Name = TextBox4
   
    Dim x, an
   x = DateAMJ(TextBox10, TextBox9, TextBox8)
   If IsError(x) Then
      MsgBox "La date est incorrecte. Corrigez la avant de valider", vbCritical
   Else
      Range("I1").NumberFormat = "dd/mm/yyyy"
      Range("I1") = x
     
    End If
   
    Range("D1").Value = TextBox1.Value
    Range("F1").Value = TextBox2.Value
    Range("D2").Value = TextBox5.Value
    Range("F2").Value = TextBox6.Value
    Range("J2").Value = TextBox7.Value

    End
End Sub

 

[patricktoulon]

a bien sur que non
si tu test 20.12 is date te donnera vrai
ca n'est pas ce que je fait
je teste 20.12 &".2000" jusqu'au 2d slash après je test les 10 caractères
soit un test isdate sur une chaîne de 10 caractères
c'est pas tout a fait la même chose

 

[mapomme]

Re @Nonomix

N'ayant pas le classeur. Je ne vois pas trop.
Essayez de mettre :

   If IsError(x) Then
      MsgBox "La date est incorrecte. Corrigez la avant de valider", vbCritical
      exit sub
   Else

 

[patricktoulon]

ps: je teste toujours avec "2000" (année bissextile)

pour pouvoir taper 29/02 ou 02/29 pour la version 1

et unique ment 29/02 pour la version FR
AUTREMENT DIT
quand j'ai 29/02 et que je ne tape pas une année bissextile on revient à "29/02/" avec un beep en pleine tronche

imparable

 

[Nonomix]

Re @Nonomix

N'ayant pas le classeur. Je ne vois pas trop.
Essayez de mettre :

   If IsError(x) Then
      MsgBox "La date est incorrecte. Corrigez la avant de valider", vbCritical
      exit sub
   Else

Je te l'envoi dans l'après midi

 

[mapomme]

je teste toujours avec "2000" (année bissextile)

J'avions déjà testé et vu...

Comme tout est bien qui finit bien, @patricktoulon , @Nonomix , je vous souhaite un bon appétit.

 

[patricktoulon]

j'ai repris l'idée de @mapomme avec les 3 textboxs
je remplace tout le code par ceci
c'est assez simple le bouton est disabled si la date n'est pas bonne ou entièrement remplie
et cela meme en revenant dessus

Option Explicit

Private Sub CommandButton1_Click()
    Range("a1") = Join(Array(TextBox4, TextBox3, TextBox2), "/")
End Sub

Private Sub TextBox2_Change(): verif TextBox2: End Sub
Private Sub TextBox3_Change(): verif TextBox3: End Sub
Private Sub TextBox4_Change(): verif TextBox4: End Sub

Sub verif(txtb)
   Dim x$
   CommandButton1.Enabled = False
    Select Case txtb.Name
    Case "TextBox2": If Val(txtb.Text) > 31 Then txtb.Value = "": Beep
        If Len(txtb.Value) = 2 Then TextBox3.SetFocus
    Case "TextBox3"
        If Val(txtb.Text) > 12 Then txtb.Value = "": Beep
        If Len(txtb.Value) = 2 And Not IsDate(TextBox2.Value & "/" & txtb.Value & "/2000") Then txtb.Value = "": Beep: 'TextBox4.Value = ""
        If Len(txtb.Value) = 2 Then TextBox4.SetFocus
    Case "TextBox4"
        If Len(txtb.Value) = 4 Then
            If Not IsDate(TextBox2.Value & "/" & TextBox3.Value & "/" & txtb.Value) Then txtb.Value = "": Beep 'Else CommandButton1.Enabled = True
        End If
    End Select
x = Join(Array(TextBox4, TextBox3, TextBox2), "/")
If Len(x) = 10 And IsDate(x) Then CommandButton1.Enabled = True
End Sub

 

[Nonomix]

J'avions déjà testé et vu...

Comme tout est bien qui finit bien, @patricktoulon , @Nonomix , je vous souhaite un bon appétit.

Voici mon tableau @mapomme, si tu veux regarder pourquoi le formulaire ferme même si la date est incorrecte. Je travaille avec Excel 2007.