Microsoft 365 Saisie des / en automatique dans textbox date

[jcf6464]

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

 

[Phil69970]

Bonjour @jcf6464

Je te propose

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]

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]

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]

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

 

[jcf6464]

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

 

[Eric C]

Re le fil.

Pour ma part, je bidouille. De plus, cela fait longtemps que je n'ai pas "mis les mains dans le camboui" alors sans fichier.... Dur dur......
@+ Eric c

 

[ChTi160]

Bonsoir le Fil
Sans fichier pas évident
Peut-être en mettant dans ton Module de Class pour le TextBox "Date"

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]

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é

'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

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

 

[patricktoulon]

re
et tu veux j'ai avec masque de saisie aussi

 

[jcf6464]

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

 

[patricktoulon]

re
a tu utilisé mon code ?

 

[jcf6464]

re
oui patrick j'ai utilisé t'on code cela fonctionne très bien

merci

 

[patricktoulon]

j'ai fait une erreur c'est 3 et non 4
If Val(Left(v, 1)) > 4 Then v = ""

 

[jcf6464]

Merci rectifier