Formulaire avec obligation de saise de date au format jj/mm/aaaa

[Skyna]

Bonjour à vous tous,

Mon problème est le suivant.
Dans un j'ai un formulaire nommé TBdtedeb dans lequel j'aimerais bloquer la saisie à un seul et unique format jj/mm/aaaa, et que si ce format n'est pas respecté qu'un message "Format incorrect" apparaisse, et si le format est correct c'est alerte est caduque.
Voici le code que j'ai tenté de faire mais qui bloque à chaque tentative de renseignement de donnée..

Private Sub TBdtedeb_Change()
Dim Valeur As Byte
TBdtedeb.MaxLength = 10 'nb caracteres maxi dans textbox
Valeur = Len(TBdtedeb)
If Valeur = 2 Or Valeur = 5 Then TBdtedeb = TBdtedeb & "/"
If Not IsDate(TBdtedeb.Value) Then
MsgBox "Format incorrect"
TBdtedeb = ""
Exit Sub
End If
End Sub

Merci d'avance pour votre aide.

 

[CHALET53]

Re : Formulaire avec obligation de saise de date au format jj/mm/aaaa

bonjour,

A adapter (notamment nom textbox)

Private Sub Textbox1_Change() 'date
Dim Valeur As Byte
TextBox1.MaxLength = 10 'nb caractères maxi autorisé dans le labtxtbat
Valeur = Len(TextBox1)
If Valeur = 2 Or Valeur = 5 Then TextBox1 = TextBox1 & "/"
End Sub
Private Sub textbox1_AfterUpdate()
If Me.TextBox1 = "" Then Exit Sub

If Left(Me.TextBox1, 2) > 31 Or Mid(Me.TextBox1, 4, 2) > 12 Then réponse = MsgBox("Format Date d'Entrée erroné" & Chr(13) & "Recommencer", vbOK): Me.TextBox1 = ""
End Sub

 

[Skyna]

Re : Formulaire avec obligation de saise de date au format jj/mm/aaaa

Bonjour Chalet53

Grâce à votre aide j'ai pu récréer ma macro de la façon suivante :

Private Sub TBdtedeb_Change() 'date
'exemple pour format xx/xx/xxxx
Dim Valeur As Byte
TBdtedeb.MaxLength = 10 'nb caractères maxi autorisé dans le labtxtbat
Valeur = Len(TBdtedeb)
If Valeur = 2 Or Valeur = 5 Then TBdtedeb = TBdtedeb & "/"
End Sub
Private Sub TBdtedeb_AfterUpdate()
If Not IsDate(TBdtedeb.Value) Then
Do
MsgBox "Format incorrect"
TBdtedeb = ""
Exit Sub
'End If
Loop
End If
End Sub

Cependant mes 2 derniers problèmes sont les suivants :
1/_ Comment puis-je renvoyer le curseur sur le formulaire TBdtedeb si la réponse est erronée
2/_ Quel format dois utiliser pour adapter cette macro à des pourcentage, ou alors pour transformer le résultat inscrit en %?

Merci par avance pour votre aide.

 

[CHALET53]

Re : Formulaire avec obligation de saise de date au format jj/mm/aaaa

Re,

Normalement avec setfocus (TBdtedeb.setfocus) ; mais je constate que dans ce cas ça ne marche pas : j'ai rajouté une procédure (à valider) :


Private Sub TBdtedeb_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If TBdtedeb.Value = "" Then Cancel = True
End Sub


As-tu remarqué que si tu saisis 12/25/2014 , il n'y a pas rejet (le pourquoi de mon test 31 et 12)

Peux-tu préciser ton point 2 ?

 

[CHALET53]

Re : Formulaire avec obligation de saise de date au format jj/mm/aaaa

tu dois pouvoir simplifier le tout :

Private Sub TBdtedeb_Change() 'date
Dim Valeur As Byte
TBdtedeb.MaxLength = 10 'nb caractères maxi autorisé dans le labtxtbat
Valeur = Len(TBdtedeb)
If Valeur = 2 Or Valeur = 5 Then TBdtedeb = TBdtedeb & "/"
End Sub
Private Sub TBdtedeb_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsDate(TBdtedeb.Value) Then
MsgBox "Format incorrect"
TBdtedeb = ""
Cancel = True
End If
End Sub


Je ne vois pas l'intérêt du DO....LOOP

 

[Skyna]

Re : Formulaire avec obligation de saise de date au format jj/mm/aaaa

Merci pour toutes ces infos, et il est vrai que le do loop ne sert à rien, je ne maitrise pas encore bien la programmation...
Une dernière chose pour terminée avec ce format date, comment faire pour bloquer l'année à 4 chiffres?
Quelque chose dans ce genre?

Or Right(Me.TBdtedeb, 2) < 1900 (je ne sais pas à quoi correspond le chiffre après la virgule.....)

Et pour ma seconde question, je voudrais créer un formulaire dans lequel le chiffre renseigné se transforme directement en % lors de la validation sur la cellule en question. (si c'est assez clair, sinon je reformulerai différemment)
Merci

 

[Skyna]

Re : Formulaire avec obligation de saise de date au format jj/mm/aaaa

J'ai un petit soucis supplémentaire avec la date. En effet lorsque la saisie est erronée, la date s'efface, le curseur revient au bon endroit, mais mon bouton "Annulé" qui se trouve sur mon formulaire est dont le code est :

Private Sub Cmdannuler_Click()
Unload Me
End Sub

ne fonctionne plus.. Je n'arrive pas à trouver la solution à ce nouveau pb...

Merci

 

[CHALET53]

Re : Formulaire avec obligation de saise de date au format jj/mm/aaaa

Pour le problème de la commande Annuler, rajoute l'instruction en gras

Private Sub TBdtedeb_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If TBdtedeb = "" Then Exit Sub
If Not IsDate(TBdtedeb.Value) Then
MsgBox "Format incorrect"
TBdtedeb = ""
Cancel = True
End If
End Sub


Right(Me.TBdtedeb, 4) < 1900 : le nombr signifie sur 4 caractères à droite

 

[CHALET53]

Re : Formulaire avec obligation de saise de date au format jj/mm/aaaa

Et pour ma seconde question, je voudrais créer un formulaire dans lequel le chiffre renseigné se transforme directement en % lors de la validation sur la cellule en question. (si c'est assez clair, sinon je reformulerai différemment)

tu veux qu'une saisie de la valeur 2.54 (par exemple) devienne dans la feuille excel : 2.54% (est-cela?)

 

[Skyna]

Re : Formulaire avec obligation de saise de date au format jj/mm/aaaa

Oui c'est cela, mais sans décimale. Merci pour l'aide d'avant cela fonctionne.

 

[CHALET53]

Re : Formulaire avec obligation de saise de date au format jj/mm/aaaa

Si le nom de la Textbox est Textbox1 et que tu veux mettre la valeur dans la cellule A2, ça doit le faire

Range("A2") = Format(Val(TextBox1) / 100, "0.00%")

 

[Skyna]

Re : Formulaire avec obligation de saise de date au format jj/mm/aaaa

Et si je fais cela, à votre avis cela est correct ou non?

'Obligation de saisie % dans temps de contrat
Private Sub TBpourctrav_Change()
'exemple pour format xx%
If TBpourctrav= "" Then Exit Sub
Dim Valeur As Byte
TBpourctrav.MaxLength = 3 'nb caractères maxi autorisé dans le labtxtbat
Valeur = Len(TBpourctrav)
If Valeur = 2 Or Valeur = 3 Then TBpourctrav= TBpourctrav& "%"
End Sub

 

[CHALET53]

Re : Formulaire avec obligation de saise de date au format jj/mm/aaaa

Le problème est que, dans la procédure tu modifies la valeur de la textbox ce qui enclenche à nouveau cette procédure (et tu te retrouves avec deux fois l'expression : %
Pour l'éviter : deux choses à faire
Modif de la procédure

Private Sub TBpourctrav_Change()
'exemple pour format xx%
If flag = 1 Then flag = 0: Exit Sub
If TBpourctrav = "" Then Exit Sub
Dim Valeur As Byte
TBpourctrav.MaxLength = 3 'nb caractères maxi autorisé dans le labtxtbat
Valeur = Len(TBpourctrav)
If Valeur = 2 Or Valeur = 3 Then flag = 1: TBpourctrav = TBpourctrav & "%"
End Sub

et mets au-dessus de toutes les procédures liées à l'userform :
dim flag as integer

sache que la gestion des valeurs dans les textboxs, c'est toujours capricieux

 

[Skyna]

Re : Formulaire avec obligation de saise de date au format jj/mm/aaaa

Je vais essayer de tester tout cela demain, et verrai si cela fonctionne.
Merci bcp pour votre aide.

 

[Skyna]

Re : Formulaire avec obligation de saise de date au format jj/mm/aaaa

Bonjour,

Je reviens à vous pour un problème qui concerne le début de l'userform (qui concerne les dates). En effet lorsque je lance la macro, la date se colle bien dans la cellule souhaitée, mais pour qu'elle soit prise en compte, je suis obligé de postionner le curseur de la souris sur cette date et de valider pour que le format date soit pris en compte. Ci-après les lignes de la commande TBdtedeb. A noter que j'ai exactement la même chose pour TBdtefin qui elle fonctionne très bien (la date étant reconnue automatiquement).


'Obligation de saisie format jj/mm/aaaa dans date de début de contrat
Private Sub TBdtedeb_Change() 'date
'exemple pour format xx-xx-xxxx
If TBdtedeb = "" Then Exit Sub
Dim Valeur As Byte
TBdtedeb.MaxLength = 10 'nb caractères maxi autorisé dans le labtxtbat
Valeur = Len(TBdtedeb)
If Valeur = 2 Or Valeur = 5 Then TBdtedeb = TBdtedeb & "-"
End Sub

'Obligation de saisie format jj/mm/aaaa dans date de début de contrat => message d'erreur
Private Sub TBdtedeb_AfterUpdate()
If Not IsDate(TBdtedeb.Value) Then
MsgBox "Format incorrect"
TBdtedeb = ""
Exit Sub
End If
If Left(Me.TBdtedeb, 2) > 31 Or Mid(Me.TBdtedeb, 4, 2) > 12 Or Right(Me.TBdtedeb, 4) < 1900 Then
MsgBox "Format incorrect"
TBdtedeb = ""
Exit Sub
End If
End Sub


Pour ce qui était de ma question concernant les %, cela ne fonctionne pas pour le moment, mais il faut que je regarde à nouveau mon code pour vérifier une éventuelle erreur..

Merci pour votre aide.