asoaomar28
Messages postés mercredi 21 mars 2007Date d'inscription
19 novembre 2009
Dernière intervention
-
18 mai 2007 à 23:16 - Dernière réponse : cs_Exploreur4824
Messages postés lundi 11 novembre 2002Date d'inscription
15 novembre 2016
Dernière intervention
- 22 mai 2007 à 08:21
Private Sub Command1_Click()
If Not Text1.Text = Format(Text1.Text, "mm/yyyy") Then
MsgBox "Mauvais format de date, format accepté : 04/2007"
End If
End Sub
A+
Exploreur
Linux a un noyau, Windows un pépin
Cette réponse vous a-t-elle aidé ?Merci pour votre retour.
N'oubliez pas de prendre quelques secondes pour remercier l'auteur : Merci pour votre retour.
Nous sommes désolés. Notre objectif est de vous donner la meilleure réponse possible.
Je pense à truc de dernière minute, il faut que ta zone de text accepte que des numériques et la barre / , Dons voici le code modifier, bon c'est pas optimisé :
Private Sub Text1_KeyPress(KeyAscii As Integer)
' On autorise que des chiffres , la touche Back et /
If Not IsNumeric(Chr(KeyAscii)) Then If KeyAscii 47 or KeyAscii 8 Then
' on fait rien
Else
KeyAscii = 0
End If
End If
End Sub
A+
Exploreur
Linux a un noyau, Windows un pépin
Cette réponse vous a-t-elle aidé ?Merci pour votre retour.
N'oubliez pas de prendre quelques secondes pour remercier l'auteur : Merci pour votre retour.
Nous sommes désolés. Notre objectif est de vous donner la meilleure réponse possible.
Encore un dernier petit truc, il faut que tu prennes en comptes que l'utilisateur ne puisse pas entrer un mois supérieur à 13, et aussi limiter l'année minimum(exemple 200)....
Intéresse toi au contrôle DtPicker et MonthView, tu vas dans projet >> composant et tu coches Microsoft Windows Common Contrôle 2
asoaomar28
Messages postés mercredi 21 mars 2007Date d'inscription
19 novembre 2009
Dernière intervention -21 mai 2007 à 21:25
0
Utile
salut Explorer
voila enfin le code(le format de la date est mm/yy) malheureusement le mois peut prendre une valeur superieur a 13 aidez moi SVP
If (Len(Text1.Text) > 4) Then
If (KeyAscii <> 8) Then
KeyAscii = 0
End If
End If
If Not IsNumeric(Chr(KeyAscii)) Then
If (KeyAscii = 8) Then
Else
If KeyAscii = 47 Then
If (Len(Text1.Text) <> 2) Then
KeyAscii = 0
End If
Else
KeyAscii = 0
End If
End If
End If
Salut,
tu t' en sotira quand même mieux avec un MaskEdit
ou à la rigueur avec un TextBox mais utiliser l' enement Validate.
Private Sub Text1_Validate(Cancel As Boolean)
If Not IsDate(Text1.Text) Then Cancel=True
End Sub
Avec ceci tu ne quitteras pas le TextBox tant que le contenu n' est pas
au format Date .Et petite cerise sur le gateau:
Private Sub Text1_KeyUp(KeyCode As Integer)
If KeyCode=VbKeyReturn Then SendKeys "{tab}"
End Sub
Si je t' ai proposé ça c' est parceque tu ne trouveras pas
beaucoup qui te feront le code Control Date avec toutes
les combinaisons possibles.Si tu veux en trouver cherches
dans les exemples rubrique Codes.
Je dis quand même coucou au passage....
Il ne me reste que quelques petits détails de gestion de selection de parties de texte en vue de remplacement...
A bientot (sûrement)
voilà où j'en étais, donc... (pour être honnête) :
Une Form et un module
Sur la Form :
une textebox Text1 (pour des dates) et une Text2 (pour les heures)
code de la Form :
Option Explicit
Private mon_format_heure As String, mon_format_date As String
'
Private Sub Text1_Change()
'Les formats date utilisables sont JJ/MM/AAAA, JJ-MM-AAAA, JJ MM AAAA,
' MM/JJ/AAAA, MM-JJ-AAAA, MM JJ AAAA et AAAA/MM/JJ, AAAA-MM-JJ ou AAAA MM JJ
mon_format_date = "JJ/MM/AAAA"
saisie_date Text1, mon_format_date
End Sub
Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
controle_selection Text1
End Sub
Private Sub Text2_Change()
'Les formats heure utilisables sont HH:MM et HH:MM:SS
mon_format_heure = "HH:MM:SS"
saisie_heure Text2, mon_format_heure
End Sub
Private Sub Text2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
controle_selection Text2
End Sub
'Tout ce qui suit n'est là que pour contrôler qu'il n'y a pas eu abandon
'avant d'avoir fini la saisie (seule la longueur est à vérifier
'puisque la cohérence a déjà été vérifiée à la saisie
Private Sub Text1_LostFocus()
If Len(Text1.Text) = 0 Then Exit Sub
If Len(Text1.Text) < Len(mon_format_date) Then Beep: Text1.SetFocus
End Sub
code du module :
Option Explicit
Public Sub saisie_date(quoi As TextBox, monfdate As String)
Static deja As String, couic As Integer If quoi.Text "" Or quoi.Text Left(deja, Len(quoi.Text)) Then deja = quoi.Text: couic = 0: Exit Sub
If couic > 0 And quoi.SelStart <> couic + 1 Then quoi.Text deja: Beep: quoi.SelStart couic: Exit Sub
Else
couic = 0
End If
Dim sais As String, ou As Integer, ou1 As Integer
Dim rf As String, rf1 As String, sp As String ', erreur As Boolean
sais = quoi.Text
sp = Mid(monfdate, 3, 1) rf "01/10/2000": rf1 "01/03/2000"
ou = 4
Select Case UCase(Left(monfdate, 1)) Case Is "M": ou 1
Case Is = "A"
sp = Mid(monfdate, 5, 1) rf "2000/10/10": rf1 "2000/03/10"
ou = 6
End Select
controlons quoi, sais, deja, couic, ou, sp, rf, rf1, monfdate
End Sub
Public Sub saisie_heure(quoi As TextBox, monfdate As String)
Static deja As String, couic As Integer
Dim sais As String, rf As String, sp As String, ou As Integer If quoi.Text "" Or quoi.Text Left(deja, Len(quoi.Text)) Then deja quoi.Text: couic 0: Exit Sub
End If
If couic > 0 And quoi.SelStart <> couic + 1 Then quoi.Text deja: Beep: quoi.SelStart couic: Exit Sub
Else
couic = 0
End If rf "00:00:00": sp ":": ou = 4
sais = quoi.Text
controlons quoi, sais, deja, couic, ou, sp, rf, rf, monfdate
End Sub
Private Sub controlons(quoi, sais, deja, couic, ou, sp, rf, rf1, monfdate)
If Len(sais) < Len(deja) Then
If quoi.SelStart = 0 Then
quoi.Text = Left(deja, 1) & quoi.Text
deja = quoi.Text quoi.SelStart 0: quoi.SelLength 1: Beep: Exit Sub
End If
If couic <> 0 Or Len(deja) - Len(sais) > 1 Then
quoi.Text = deja: Beep: Exit Sub
End If
If quoi.SelStart < Len(deja) - 1 Then
couic = quoi.SelStart
Else
couic = 0
End If If quoi.SelStart < Len(deja) - 1 And (quoi.SelStart ou - 2 Or quoi.SelStart ou + 1) Then quoi.Text deja: couic 0: Exit Sub
End If deja sais: quoi.Text deja: Exit Sub
End If
Dim ou1 As Integer, erreur As Boolean
ou1 = InStr(rf, "/") + InStr(rf, ":") - 1 If Right(sais, 1) "0" Then rf rf1 If Len(sais) ou And Val(Mid(sais, ou)) > 1 + (100 * InStr(rf, ":")) Then erreur True
If Len(sais) > Len(monfdate) Then erreur = True
If Not IsDate(sais & Mid(rf, Len(sais) + 1)) Or Val(Mid(sais, ou, 2)) > 12 + (100 * InStr(rf, ":")) _
Or InStr(quoi.Text, sp) + 1 > ou + 1 Then erreur = True
If erreur Then
quoi.Text = deja
If couic > 0 Then quoi.SelStart = couic couic 0: Beep: erreur 0: Exit Sub
Else If Len(sais) ou1 Or (Len(sais) ou1 + 3 And Len(monfdate) > 7) Then quoi.Text = sais & sp deja quoi.Text: quoi.SelStart Len(deja)
End If
erreur = False
End Sub
Public Sub controle_selection(mon_ctrl As TextBox)
If Not IsNumeric(Left(mon_ctrl.SelText, 1)) Then
mon_ctrl.SelLength = 0: Exit Sub
End If
If mon_ctrl.SelText = mon_ctrl.Text Then Exit Sub
If mon_ctrl.SelLength > 1 Then
If mon_ctrl.SelStart > 1 And mon_ctrl.SelStart + mon_ctrl.SelLength >= Len(mon_ctrl.Text) Then
Exit Sub
End If
mon_ctrl.SelLength = 0
End If
End Sub
Private Sub Text2_LostFocus()
If Len(Text2.Text) = 0 Then Exit Sub
If Len(Text2.Text) < Len(mon_format_heure) Then Beep: Text2.SetFocus
End Sub
C'est déjà pas mal, mais pas encore totalement complet en matière de gestes avec la souris...(en cours, donc...)
