XL 2016 Format Date "##/##/####" dans TextBox

Lorenzini

XLDnaute Occasionnel
Bonjour,
Est-il possible d'afficher un textbox avec les slash de séparation pour une date (sans devoir les taper) ?
L'utilisateur n'aurait qu'à rentrer le jour, p.ex. 12, puis, le curseur se déplacerait après le slash déjà présent.
Il rentrerait ensuite le mois, p.ex. 05...le curseur se déplacerait de nouveau après le second (et dernier) slash aussi présent... puis, il ne resterait plus qu'à rentrer l'année : p.ex. 2020... et au final, mon textbox afficherait : 12/05/2020
J'ai trouvé ces qq lignes de code sur le web et les ai (dans les limites de mes connaissances rudimentaires en VBA) "bidouillées" à mon goût.
Ce n'est pas mal, mais ce n'est pas encore ce que je recherche.
Le code en question ne permet la saisie que des chiffres (0 à 9) et affiche les "/" au fur et à mesure de la saisie.
Pouvez-vous me dire si afficher un textbox avec slashs comme expliqué ce-dessus est réalisable en VBA ?
Merci :)

VB:
'********************************************************************************************************************************
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If Len(TextBox1.Text) <> 10 Or Not IsDate(TextBox1.Text) Then
        MsgBox "Entrez la date avec le format 'jjmmaaaa' !"
            TextBox1.Text = ""
            TextBox1.SetFocus
            Exit Sub
    End If
End Sub
'*******************************************************************************************************************************
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 8 Then
        If Right(TextBox1, 1) = "/" Then TextBox1 = Mid(TextBox1, 1, Len(TextBox1) - 1)
        ElseIf KeyCode = 46 Then TextBox1 = ""
    End If
End Sub
'********************************************************************************************************************************
Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode < 96 Or KeyCode > 105 Then
        If TextBox1 <> "" Then TextBox1 = Left(TextBox1, Len(TextBox1) - 1)
    End If
    Select Case Len(TextBox1.Text)
    Case 2: If Val(TextBox1.Value) > 31 Then TextBox1.Value = "": MsgBox "jour trop grand" Else TextBox1 = TextBox1 & "/"
    Case 5: If Mid(TextBox1, 4, 2) > 12 Then TextBox1.Value = Mid(TextBox1, 1, 3): MsgBox "mois trop grand" Else TextBox1 = TextBox1 & "/"
    Case 10: If Not IsDate(TextBox1) Then MsgBox "Tu veux une claque ou quoi ?" & vbCrLf & " Où t'as vu que ce jour existe dans le calendrier" & vbCrLf & " Allez recommence !!!": TextBox1 = ""
    Case 11: TextBox1 = Mid(TextBox1, 1, 10)
    End Select
End Sub
'********************************************************************************************************************************
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If InStr("0123456789", Chr(KeyAscii)) = 0 Then KeyAscii = 0
End Sub
'********************************************************************************************************************************
 

jmfmarques

XLDnaute Accro
Re

je disais plus haut :
EDIT : sauf à faire une usine à gaz non totalement infaillible, ce genre d'"amélioration" de la convivialité aboutit dans la plupart des cas à une complication de la vie de l'utilisateur ...
Le code montré en message #15 met en exergue tout le sens de cette phrase (finir par compliquer la vie de l'utilisateur au prétexte de la lui faciliter).
je n'ai pas l'intention de dresser un inventaire (ce serait trop long) des "os" ainsi infligés à l'utilisateur. je vais me contenter du tout premier :
- l'utilisateur saisit 29/02/2019 -->> 2019 ne passe bien sûr pas
- l'utilisateur comprend pourquoi et veut modifier en 8 le 9 de 29. il sélectionne ce 9 et frappe 8
- et voici devant quoi il va se trouver : 29/02/8
il va s'énerver et finir, certes, par comprendre qu'il a intérêt à tout effacer et tout reprendre à zéro. Je doute fort qu'il apprécie ce genre de "convivialité" qui lui impose finalement plus de gestes que ceux qui étaient nécessaires, sans cette "convivialité". :cool:
 

patricktoulon

XLDnaute Barbatruc
re
@jmfmarques
il est nullement ici question de corriger quelque chose qui a déjà été tapé mais seulement l'ajout dynamique des séparateurs et empêcher de taper une date erronée
si il veux l'absolu en effet ça a un prix

et là je te garanti qu'il est impossible de taper une date erronée en rédaction ou en reprise
 

jmfmarques

XLDnaute Accro
tu tape avec ton pavé numérique
- soit tu n'as pas lu les gestes définis dans mon message #16
- soit tu les as lus mais pas faits
- soit tu les as lus et faits et cette réponse voudrait alors dire que tu obliges l'utilisateur à ne se servir que de son clavier, pour effacer puis reprendre.
Quel beau progrès en matière de convivialité ! :cool:

EDIT : si c'est pour en arriver à cela, l'utilisateur aura sa vie moins compliquée avec un simple contrôle maskedit (pour les "/") et une vérification de validité de date in fine
 

Lorenzini

XLDnaute Occasionnel
re
j'avais donné déjà une solution complète simplifiée sans masque de saisie
avec séparateur automatique et correction de date erronée
et qui n'enlevais pas la possibilité d'utiliser les touches back et suppr
elle aussi basé sur l'interception de la touche
cette solution je l'ai transformé en fonction pour pourvoir l'utiliser sur 36 textboxs dans le même userform
j'ai donc 2 versions
une US/FR (yyy/mm/dd ou dd/mm/yyyy)
et l'autre uniquement FR dd/mm/yyyy
ici je vous livre la version FR avec 2 textboxs
si vous tapez une erreur ben vous avez un beep et la portion de date en erreur est supprimé
VB:
Option Explicit
Const separator As String = "/"

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    ControlValiddateFR TextBox1, KeyAscii
End Sub

Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    ControlValiddateFR TextBox2, KeyAscii
End Sub


Private Sub ControlValiddateFR(txtb, KeyAscii)    'uniquement FR
    Dim t$
    If Not Chr(KeyAscii) Like "*[0-9]*" Then KeyAscii = 0: Exit Sub
    With txtb
        t = .Value    'Mid(.Value, 1, .SelStart)
        t = t & Chr(KeyAscii):
        If Len(t) = 2 Or Len(t) = 5 Then t = t & separator
        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

vous n'avez plus qu'a essayer et taper des erreurs pour voir le comportement
Bonjour patricktoulon, super le code que tu as fais !
 

Lorenzini

XLDnaute Occasionnel
re
@jmfmarques
il est nullement ici question de corriger quelque chose qui a déjà été tapé mais seulement l'ajout dynamique des séparateurs et empêcher de taper une date erronée
si il veux l'absolu en effet ça a un prix

et là je te garanti qu'il est impossible de taper une date erronée en rédaction ou en reprise
WAW ! je suis impressiionné ! Il marche du tonnerre ton code ; merci PatrickToulon !!
 

patricktoulon

XLDnaute Barbatruc
attends puisque ça te plait
le voila avec la reprise ça va plaire a notre ami jmfmarques ça :p :p :p :p

VB:
Option Explicit
Const separator As String = "/"

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    ControlValiddateFR TextBox1, KeyAscii
End Sub



Private Sub ControlValiddateFR(txtb, KeyAscii)    'uniquement FR
    Dim t$, pos&
    If Not Chr(KeyAscii) Like "*[0-9]*" Then KeyAscii = 0: Exit Sub
    With txtb
        t = .Value    'Mid(.Value, 1, .SelStart)
        If .SelStart + 1 < Len(t) Then
            Mid(t, .SelStart + 1, 1) = Chr(KeyAscii): pos = .SelStart + 1
        Else
            t = t & Chr(KeyAscii):
        End If
        If Len(t) = 2 Or Len(t) = 5 Then t = t & separator
        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
        If pos > 0 Then .SelStart = pos: If Mid(t, pos + 1, 1) = "/" Then .SelStart = pos + 1
    End With
    KeyAscii = 0
End Sub



demo4.gif
 

patricktoulon

XLDnaute Barbatruc
tiens tu pourra pas taper en dessous de 1000
si tu veux plus exprime toi ;)
VB:
Private Sub ControlValiddateFR(txtb, KeyAscii)    'uniquement FR
    Dim t$, pos&
    If Not Chr(KeyAscii) Like "*[0-9]*" Then KeyAscii = 0: Exit Sub
    With txtb
        t = .Value    'Mid(.Value, 1, .SelStart)
        If .SelStart + 1 < Len(t) Then
            Mid(t, .SelStart + 1, 1) = Chr(KeyAscii): pos = .SelStart + 1
        Else
            t = t & Chr(KeyAscii):
        End If
        If Len(t) = 2 Or Len(t) = 5 Then t = t & separator
        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) = 7 And Mid(t, 7, 1) < 1 Then t = Left(t, 6): Beep'neww!! not year<1000
       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
        If pos > 0 Then .SelStart = pos: If Mid(t, pos + 1, 1) = "/" Then .SelStart = pos + 1
    End With
    KeyAscii = 0
End Sub
 

Discussions similaires

Réponses
12
Affichages
393