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

[Lorenzini]

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

'********************************************************************************************************************************
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]

y va être content le jacques avec son dell

"le jacques", Patrick, n'a aucune raison d'être ou non content, dès lors (relis-le) qu'il évite comme la peste les fausses "convivialités" qui aboutissent à de vraies gênes.
"le jacques" a depuis longtemps compris qu'il était très nettement préférable et moins onéreux de laisser saisir normalement et de contrôler in fine la validité de la saisie (ce que, comme tu l'as toi-même dit un peu plus haut, tu dois faire de toutes manières).
Bon ... Je laisse de ce pas d'autres faire part de leurs observations (il y en a) car je ne peux continuer à dépenser mon temps à pointer du doigt ce qui ne va pas.

 

[patricktoulon]

re
arrete de dire que ça ne va pas , c'est l'objectivité même de la démarche qui ne te convient pas
et ça je pense que tout le monde a compris
ça commence même a être du radotage

d'ailleurs celle ci sera ma version FR simple
je vais encore la peaufiner en terme de code et de souplesse en terme d'argument mais le moteur est bon
dommage que ca soit trop cher pour ton DELL

 

[jmfmarques]

ça commence même a être du radotage

et cela continuera systématiquement compte tenu de ce qui est observé. Et ce : que tu le veuilles ou non, car nous sommes sur un forum technique dont les membres n'aspirent pas à être enfarinés.

Je le répète donc : je vais laisser à d'autres le soin de pointer du doigt ce qu'il convient de pointer du doigt; en observant que le nombre de modifications apportées (jusqu'à présent) n'est pas de nature à rassurer.
Et en observant que Microsoft lui-même a choisi un autre mécanisme et une autre philosophie en matière de saisie de dates (y compris pour modifier la date système).

 

[patricktoulon]

re
microsoft c'est microsoft et bilou n'est pas là alors
et le nombres apporté n'est pas c'est juste des version différente opérant un replace ou un sellength
oui d'autres c'est bien aussi
et pour coller cela dans n'importe quel userform
je supprime les const globale et gère tout dans la sub

'****************************************
'textbox date controlée version FR
'patricktoulon
'version 12/06/2014
'mise a jour
'date 11/05/2020
' condensation du code
'basé sur le mid(texte,1,5)+année permutée ce qui permet de faire moins de tests
'remise en place du pavé numerique haut du clavier(special jacou!!)
'******************************************
Option Explicit


Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    control_saisieX TextBox1, KeyCode, "__/__/____"
End Sub

Sub control_saisieX(txt As Object, KeyCode, Mask)
    Dim Pos&, T$, X&, XL&, xp&, an, separateur
    separateur = Mid(Mask, 3, 1)
    With txt
        If .Value = "" Then .Value = Mask
        T = .Value: .SelStart = IIf(T = Mask, 0, .SelStart): X = .SelStart: XL = .SelLength
        If KeyCode <= 57 And KeyCode >= 47 Then KeyCode = KeyCode + 48 'convertion keycode pavé haut-->pavé droite
        Select Case KeyCode
        Case 96 To 105    'pavé numerique
            Select Case X
            Case 0 To 1, 3 To 4, 6 To 9    'en fonction du selstart
                XL = IIf(XL = 0, 1, XL)
                Mid$(T, X + 1, XL) = Chr(KeyCode - 48) & Mid$(Mask, X + 2, XL): X = X + 1    'placement du caractere

                'controle date condensé
                If Val(T) > 31 Then Mid$(T, 1, 2) = Mid$(Mask, 1, 2): X = 0: Beep    'max 31 pour jour
                If Val(Mid(T, 4, 2)) > 12 Then Mid$(T, 4, 2) = Mid$(Mask, 4, 2): X = 3: Beep    ' max 12 pour le mois
                If X > 5 Then xp = 7 Else If X < 4 Then xp = 1 Else xp = 4    'calcul position pour replace by mask
                If IsNumeric(Mid(T, 7, 4)) And X > 5 Then an = Mid(T, 7, 4): XL = 5 Else an = "2000": XL = 2    'année permuté
                If IsDate(Mid(T, 1, 5)) Then
                    If Not IsDate(Mid(T, 1, 5) & separateur & an) Then Mid(T, xp, XL) = Mid(Mask, xp, XL): Beep: X = InStr(1, T, "_") - 1
                End If

                .Value = T: .SelStart = IIf(Mid(Mask, X + 1, 1) = separateur, X + 1, X)    'mise a jour textbox et positionement final

            Case Else: .SelStart = X + 1: KeyCode = 0
            End Select

        Case 8: If X > 0 Then Mid(T, X, 1) = Mid(Mask, X, 1): .Value = T: .SelStart = X - 1:
        Case 46: Mid(T, X + 1, XL) = Mid(Mask, X + 1, XL): .Value = T: .SelStart = X    'touche "suppr"
        Case Else: KeyCode = 0    'aucune autre touche autorisée
        End Select
    End With
    KeyCode = 0:
End Sub

testé et re testé
et je viens même de m’apercevoir que pour le mode US "MM/DD/YYYY"
ya pas grand chose a changer !! 2 nombres pour être exacte la aussi j'ai testé

 

[jmfmarques]

testé et re testé

comme ce qui, au cours des deux dernières années et pour ce même outil, avait également été "testé et re testé " ?
Mais moi, maintenant, j'arrête de tester (j'ai d'autres occupations).

 

[patricktoulon]

ok bon vent mon cher jacques
les méthodes sont acquises et éprouvées seul le contexte de l'utilisateur peut varier
donc si tu ne veux plus participer personne ne t'en voudra il n'y a pas de soucis
merci en tout ça de m'avoir rappeler le pavé haut que j'avais oublié de remettre dans mes 3 versions
et bonne journée a toi

 

[Lorenzini]

Bonjour Lorenzini, le forum.
Voici un petit programme VBA qui fait seulement cela. Il est base sur un principe tres simple, soit demarrer avec ce texte __/__/____ dans le Textbox et remplacer l'un apres l'autre dans le Textbox les 8 caracteres _ (caractere de soulignement).

Bonjour Docmarti, waw ! Pas mal non plus ton TextBox... Beau boulot !

 

[fanch55]

bonsoir fanch55
je ne sais ce que tu a essayé mais c'est pas mon date box 29/02/2019 et tout bonnement impossible
à taper
d'autant plus qu'il ne fonctionne pas sur oleobject(sur feuille) donc soit tu l'a modifié soit c'est pas mon code

il strictement conçu pour textboxs on userform alors ta capture sur feuille me laisse perplexe

Salut Patrick,
Le code utilisé est celui du

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

Quand je teste quelque chose, je n'y modifie absolument rien, , je n'y vois aucun intérêt par ailleurs.
Je te certifie qu'il s’exécute tel quel sur un activex de Feuille, quand on regarde le code, rien ne pourrait l'en empêcher .

Ceci dit, je vais tester ta dernière proposition, sans rien y changer ...

 

[fanch55]

****************************************
'textbox date controlée version FR
'patricktoulon
'version 12/06/2014
'mise a jour
'date 11/05/2020
' condensation du code
'basé sur le mid(texte,1,5)+année permutée ce qui permet de faire moins de tests
'remise en place du pavé numerique haut du clavier(special jacou!!)

Voilà, testé le code, celui-ci est bien meilleur mais pas encore parfait .
Pour la forme ;
Assez énervant que quand tu tapes un mauvais 2ème chiffre, il failler retaper le 1er .
bizarre de ne pas pouvoir utiliser les flèches du clavier alors qu'on se positionner n'importe où avec la souris .

L'exit ou le lostfocus sera primordial pour contrôler la date

 

[patricktoulon]

re
bon me voila rentré
oui fansh55 le exit ou lostfocus est requis pour le controle like"*_*" comme je l'ai dit vba ne devinera jamais tes intentions

Assez énervant que quand tu tapes un mauvais 2ème chiffre, il failler retaper le 1er .

oui va dire a vba toi que c'est le 1er ou le 2d qui est une erreur


pour le fleches si tu veux je te les remet c'est pas un soucis
Case 37: .SelStart = Application.Max(.SelStart - 1, 0)
Case 39: .SelStart = Application.Min(.SelStart + 1, Len(T))

 

[fanch55]

re Patrick,
Je n'ai aucune demande spécifique en particulier.
Pour m'être heurté aux désidératas légitimes des usagers, une datebox doit faciliter la vie des utilisateurs : saisir une date rapidement et manuellement avec une chance (quasi) nulle de se tromper .
Je dois avouer que toutes mes tentatives ont été dérisoires à l'épreuve du terrain.
J'en suis encore à rester rêveur sur certaines datebox que l'on trouve en HTML ...

 

[jmfmarques]

Pour m'être heurté aux désidératas légitimes des usagers, une datebox doit faciliter la vie des utilisateurs

Je ne saurais assez plussoyer.
En rappelant que :
- s'il s'agit d'éviter à l'utilisateur de frapper deux "/", existe le contrôle maskedit
- puisque, de toutes manières, l'on doit nécessairement vérifier la validité de la saisie au moment de quitter la textbox, cela se fait de la manière la plus simple du monde en deux lignes de code (que j'ai montrées très récemment)

 

[patricktoulon]

re
A ben de mieux en mieux maintenant on a besoins du complément toolsbox et son Maskedit pour 2 slashs alors que cette partie je le fait en une moitié de ligne sans gêner le principe d'aucun événement dans le model sans masque


t=.value:If Len(t) = 2 Or Len(t) = 5 Then t = t & separator
.Value = Mid(t, 1, 10)

 

[jmfmarques]

on a besoins du complément toolsbox et son Maskedit pour 2 slashs

Me relire :

s'il s'agit d'éviter à l'utilisateur de frapper deux "/", existe le contrôle maskedit

1) même ce "confort" n'est vraiment pas nécessaire.
2) et même si on y tient (à ce minuscule "confort"), un contrôle maskededit ne mange pas plus de pain que la textbox ! (on n'en dira pas autant de tout le mécanisme mis en place pour assurer un "confort" qui s'avère finalement assez "castrateur").
Bref ...

 

[Docmarti]

Bonjour Docmarti, waw ! Pas mal non plus ton TextBox... Beau boulot !

Merci du retour.