Microsoft 365 Saisie des / en automatique dans textbox date

jcf6464

XLDnaute Occasionnel
Bonjour le forum
J'ai dans un module de classe ce code que j'ai récupère sur ce site ,
'les contrainte dans les evenement pour chaque type de textbox
Private Sub textDate_Change()
Dim T$
T = Mid(textDate.Text, 1, 10)
If Mid(T, 1, 1) > 3 Then T = ""
If Len(T) = 2 And Val(T) > 31 Then T = Mid(T, 1, 1)
If Len(T) >= 3 And Mid(T, 3, 1) <> "/" Then T = Mid(T, 1, 2)
If Len(T) >= 4 And Val(Mid(T, 4, 1)) > 1 Then T = Mid(T, 1, 3)
If Len(T) >= 5 And Val(Mid(T, 4, 2)) > 12 Then T = Mid(T, 1, 4)
If Len(T) >= 6 And Mid(T, 6, 1) <> "/" Then T = Mid(T, 1, 5)
If Len(T) = 10 And Not IsDate(T) Then MsgBox T & vbCrLf & "la date entrée n'est pas valide" & vbCrLf & "veuillez recommencer": T = "":
textDate = T
End Sub
Je souhaiterai si cela est possible que le / soit en automatique des que j'ai saisi les deux premier chiffres et ainsi que les deux autres,

Merci à vous tous
bonne journée jean claude
 
Solution
Bonjour @jcf6464 je reconnais bien une partie de mes code de classe de ma collection textbox formaté
si tu cherche bien tu devrais trouver mes classe textbox formaté
date tel secu iban etc...

le problème avec ta classe c'est que tu utilise l'event change
et je ne sais combien de fois je l'ai dis il ne faut pas utiliser l'event change si tu veux le "/" automatique
car imagine tu te trompe tu tape la touche del et tu est juste devant un"/" ben tu es coincé puisque ca le remettra tout de suite


c'est l'event keydown

je te donne un exemple mon module classe il se nomme txtbformat
j'ai renommé ma classe comme toi et l'event de substitution aussi
tu met "date" dans le tag de chaque textbox concerné

VB:
...

Phil69970

XLDnaute Barbatruc
Bonjour @jcf6464

Je te propose

VB:
Private Sub TextBox1_Change()
Dim MaDate As Byte
TextBox1.MaxLength = 8 ' <== mets 10 si tu veux l'année sur 4 chiffres
MaDate = Len(TextBox1)
If MaDate = 2 Or MaDate = 5 Then TextBox1 = TextBox1 & "/"
End Sub

Private Sub UserForm_Initialize()
TextBox1.Value = "00/00/00"  ' <== ou "00/00/0000" si tu as choisi l'année sur 4 chiffres
End Sub

Merci de ton retour
 

jcf6464

XLDnaute Occasionnel
Bonjour Phil69970 et le forum,

Merci pour ta réponse j'ai déjà cela pour les textbox,
Toutes mes excuses J'ai oublie de dire que c'est dans un module de classe,

J'ai sur le formulaire 10 textbox date donc je transforme en passant par le module de classe pour moins de lignes de codes

cordialement jean claude
 

scraper

XLDnaute Nouveau
Bonjour Jcf6464, Jean-Claude

Je vais aussi implémenter un module de classe pour générer un userform qui permet d'entrer une amplitude (in intervalle entre deux dates) sur les dates.

Cela me semble judicieux en effet mais ce n'est pas le nombre de lignes de code qui me motive mais plutot le style de programmation plus orienté objet.

Bonne chance
 

Eric C

XLDnaute Barbatruc
Bonjour le forum
Bonjour jcf6464, Philippe et scraper

En reprenant une idée mise en ligne (les auteurs sont cités dans le code) et le code de notre ami Phil69970, je te joints ce fichier qui devrait te suffire.

Bonne fin de journée à toutes & à tous
Eric c
 

Pièces jointes

  • Nombreux TextBoxs - Date avec slash.xlsm
    23.3 KB · Affichages: 9

jcf6464

XLDnaute Occasionnel
Bonjour Eric C et le forum,

Merci cela ne me convient pas j'ai un module de classe existant voir code joint avec tag ,
Je souhaiterai si cela est possible que le / soit en automatique des que j'ai saisi les deux premier chiffres et ainsi que les deux autres,
Merci à vous tous
bonne journée jean claude

Public WithEvents textDate As MSForms.TextBox
Public WithEvents textTEL As MSForms.TextBox
Public WithEvents textLettre As MSForms.TextBox
Public usf As Object
Dim cls() As New specialtextbox
Option Compare Text

Function initiate(uf)
For Each ctrl In uf.Controls


If ctrl.Tag = "date" Then i = i + 1: ReDim Preserve cls(1 To i): Set cls(i).textDate = ctrl: ctrl.Tag = "": Set usf = uf
If ctrl.Tag = "tel" Then i = i + 1: ReDim Preserve cls(1 To i): Set cls(i).textTEL = ctrl: ctrl.Tag = "": Set usf = uf
If ctrl.Tag = "lettre" Then i = i + 1: ReDim Preserve cls(1 To i): Set cls(i).textLettre = ctrl: ctrl.Tag = "": Set usf = uf
Next
End Function

'on bloque les numerique ou les lettres selon le type de textbox
Private Sub textDate_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger): KeyAscii = IIf(Not Chr(KeyAscii) Like "[0-9/]", 0, KeyAscii): End Sub
Private Sub textTEL_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger): KeyAscii = IIf(Not Chr(KeyAscii) Like "[0-9 ]", 0, KeyAscii): End Sub
Private Sub textLettre_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger): KeyAscii = IIf(IsNumeric(Chr(KeyAscii)), 0, KeyAscii): End Sub

Private Sub textTEL_Change() 'mise en forme de 6 telephones
Dim T$, mem$
T = Mid(textTEL.Text, 1, 15) 'passer de 14 à 15 pour les internationaux 33,34,etc...
mem = textTEL.Tag
If (Len(T) = 2 Or Len(T) = 5 Or Len(T) = 8 Or Len(T) = 11) And Len(mem) < Len(T) Then T = T & " " 'on peut mettre un point entre les ""
textTEL = T
textTEL.Tag = textTEL.Text
End Sub

'les contrainte dans les evenement pour chaque type de textbox
Private Sub textDate_Change()
Dim T$
T = Mid(textDate.Text, 1, 10)
If Mid(T, 1, 1) > 3 Then T = ""
If Len(T) = 2 And Val(T) > 31 Then T = Mid(T, 1, 1)
If Len(T) >= 3 And Mid(T, 3, 1) <> "/" Then T = Mid(T, 1, 2)
If Len(T) >= 4 And Val(Mid(T, 4, 1)) > 1 Then T = Mid(T, 1, 3)
If Len(T) >= 5 And Val(Mid(T, 4, 2)) > 12 Then T = Mid(T, 1, 4)
If Len(T) >= 6 And Mid(T, 6, 1) <> "/" Then T = Mid(T, 1, 5)
If Len(T) = 10 And Not IsDate(T) Then MsgBox T & vbCrLf & "la date entrée n'est pas valide" & vbCrLf & "veuillez recommencer": T = "":
textDate = T
End Sub

'
Private Sub textLettre_Change()

End Sub


''donc dans les tag des textboxs tu mettra selon le type que tu veux "date","tel" ou "lettre"
et donc selon le type je corrige le keyascii dans le keypress
 

ChTi160

XLDnaute Barbatruc
Bonsoir le Fil
Sans fichier pas évident
Peut-être en mettant dans ton Module de Class pour le TextBox "Date"
VB:
Public WithEvents textDate As MSForms.TextBox
Private Sub  textDate_Change()
Dim MaDate As Byte
With textDate
                        .MaxLength = 8 ' <== mets 10 si tu veux l'année sur 4 chiffres
MaDate = Len(.Text)
If MaDate = 2 Or MaDate = 5 Then .Text = .Text & "/"
End with
End Sub
Non testé bien sûr ! Lol
Jean marie
 

patricktoulon

XLDnaute Barbatruc
Bonjour @jcf6464 je reconnais bien une partie de mes code de classe de ma collection textbox formaté
si tu cherche bien tu devrais trouver mes classe textbox formaté
date tel secu iban etc...

le problème avec ta classe c'est que tu utilise l'event change
et je ne sais combien de fois je l'ai dis il ne faut pas utiliser l'event change si tu veux le "/" automatique
car imagine tu te trompe tu tape la touche del et tu est juste devant un"/" ben tu es coincé puisque ca le remettra tout de suite


c'est l'event keydown

je te donne un exemple mon module classe il se nomme txtbformat
j'ai renommé ma classe comme toi et l'event de substitution aussi
tu met "date" dans le tag de chaque textbox concerné

VB:
'patricktoulon
Public WithEvents textDate As MSForms.TextBox

Dim cls() As New specialtextbox

Public Function clformat(uf)
    Dim a, ctrol
    For Each ctrol In uf.Controls
        If ctrol.Tag = "date" Then
            a = a + 1: ReDim Preserve cls(1 To a): Set cls(a).textDate = ctrol
        End If
    Next
End Function
Private Sub textDate_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode >= 48 And KeyCode <= 57 Then KeyCode = KeyCode + 48
    v = textDate.Value
    Select Case KeyCode
    Case 96 To 105
        KeyCode = KeyCode - 48
        If Len(v) = 2 Or Len(v) = 5 Then v = v & "/"
        v = v & Chr(KeyCode)
        If Val(Left(v, 1)) > 4 Then v = ""
        If Val(v) > 31 Then v = ""
        If Mid(v, 4, 1) > 1 Then v = Left(v, 3)
        If Mid(v, 4, 2) > 12 Then v = Left(v, 3)
        If Len(v) = 2 Or Len(v) = 5 Then v = v & "/"
        If Len(v) >= 6 Then If Not IsDate(Mid(v, 1, 6) & "2000") Then v = Left(v, 3)
        KeyCode = 0
        If Len(v) = 10 Then If Not IsDate(v) Then v = Left(v, 6)
        textDate.Value = Mid(v, 1, 10)
    Case 13
        KeyCode = 13
    Case 8
        X = InStrRev(v, "/")
        If X > 0 Then v = Left(v, X - 1) Else v = ""
        textDate = v
        KeyCode = 0
    Case 46
        textDate = ""
    Case Else: KeyCode = 0
    End Select

End Sub
et dans mon userform
Code:
Dim cl As New specialtextbox

Private Sub UserForm_Activate()
cl.clformat Me
End Sub

terminé tes séparateurs de date seront automatiques avant et après en cas de correction
les textbox n'accepteront que les touches du pavé 0 à 9 et les touches 0 à 9 du haut du clavier
et la touche del et la touche enter toutes les autres touches bye bye!!

j'ai remis le control de validité de date de A à Z
bien sur ça implique le format français et uniquement le format français
voila

;)

je livre l'exemple comme ca vite fait
 

Pièces jointes

  • exemple classe datebox simplifiée.xlsm
    19.4 KB · Affichages: 9

jcf6464

XLDnaute Occasionnel
Bonjour Partick, eric chti160, Phil69970,et le forum,

merci à vous tous cela fonctionne comme je le souhaite,

patricktoulon : pour le masque date de saisie je l'ai et je l'emploie sur d'autres dates

J'aurai d'autres question sur les modules lettres
Bonne journée sous la pluie ici
Jean claude
 

Discussions similaires

Statistiques des forums

Discussions
313 193
Messages
2 096 084
Membres
106 492
dernier inscrit
schneider