Textebox en forme date
Résolu
aminesc
Messages postés
70
Date d'inscription
dimanche 25 octobre 2015
Statut
Membre
Dernière intervention
3 juillet 2017
-
31 janv. 2016 à 22:37
Linoa85 - 20 avril 2016 à 13:56
Linoa85 - 20 avril 2016 à 13:56
A voir également:
- Textebox en forme date
- Sql insert date ✓ - Forum SQL
- Vb.net format date - Forum Visual Basic
- Vba date to string - Forum Visual Basic
- Sql comparaison date - Forum SQL
- Sql max date ✓ - Forum SQL
16 réponses
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
211
Modifié par ucfoutu le 4/02/2016 à 07:53
Modifié par ucfoutu le 4/02/2016 à 07:53
Chose promise, chose due ===>>>
Modifications apportées :
1) mise à disposition dans un module (insertion ===>> module) des procédures de traitement.
Elle seront ainsi accessibles pour plusieurs textboxes, d'un même userform ou plusieurs. Et elles n'encombreront que peu le code de chaque userform.
2) utilisation de la touche espace
-- un appui sur cette touche, lorsque fait à la place du premier chiffre d'une partie de date (jour, mois ou année), complète automatiquement (date totale du jour, mois et année en cours, année en cours)
3) utilisation de la touche flèche gauche :
un appui sur cette touche (uniquement au tout début de la saisie) complète automatiquement par la dernière date saisie précédemment dans cette textbox.
Utilité ? ===>> lors du "remplissage" de formulaires, états, etc ... successifs et quasi répétitifs
4) Correction des saisies :
tu as déjà vu que l'on pouvait les faire à l'aide de la touche retour-arrière.
Elles sont maintenant également possibles à l'aide de la touche SUPPR (sur sélection dans le texte).
Le principe est toujours le même : on ne peut effacer qu'en partant de la droite vers la gauche et toujours depuis la fin
==========================
Tu vas tester tout cela maintenant (et tout comprendre) :
Dans un module (insertion ===>> module) : ce code :
Su ton userform (fais tes tests sur un nouvel userform) :
- 3 textboxes : T-date1, T_date2 et T_date3
- un label Msg_date avec sa propriété visible = False
- un bouton de commande CommandButton1, qui n'est là que pour te permettre de tester ce que donne la flèche gauche après effacements (comme expliqué plus haut)
- ce code :
Lance, amuse-toi ... tu vas tout comprendre.
________________________
Nul ne saurait valablement coder ce qu'il ne saurait exposer clairement.
Modifications apportées :
1) mise à disposition dans un module (insertion ===>> module) des procédures de traitement.
Elle seront ainsi accessibles pour plusieurs textboxes, d'un même userform ou plusieurs. Et elles n'encombreront que peu le code de chaque userform.
2) utilisation de la touche espace
-- un appui sur cette touche, lorsque fait à la place du premier chiffre d'une partie de date (jour, mois ou année), complète automatiquement (date totale du jour, mois et année en cours, année en cours)
3) utilisation de la touche flèche gauche :
un appui sur cette touche (uniquement au tout début de la saisie) complète automatiquement par la dernière date saisie précédemment dans cette textbox.
Utilité ? ===>> lors du "remplissage" de formulaires, états, etc ... successifs et quasi répétitifs
4) Correction des saisies :
tu as déjà vu que l'on pouvait les faire à l'aide de la touche retour-arrière.
Elles sont maintenant également possibles à l'aide de la touche SUPPR (sur sélection dans le texte).
Le principe est toujours le même : on ne peut effacer qu'en partant de la droite vers la gauche et toujours depuis la fin
==========================
Tu vas tester tout cela maintenant (et tout comprendre) :
Dans un module (insertion ===>> module) : ce code :
Option Explicit
Public Sub teste_date(ByRef t As MSForms.TextBox, ByRef cod As MSForms.ReturnInteger, ByVal flt As String, scl As Boolean)
Dim ici As Byte, sp As String, cr As String, drf As String, dtt As String, siecle As Boolean
sp = Left(Replace(flt, "#", ""), 1)
drf = "31" & sp & "12" & sp & "2000" 'ne touche jamais rien à cette chaine
With t
ici = .SelStart
If cod = 46 And .SelText = Mid(.Text, ici + 1) Then
.Text = Left(.Text, ici)
If Len(.Text) = 2 Or Len(.Text) = 5 Then .Text = Left(.Text, Len(.Text) - 1)
cod = 0: Exit Sub
End If
If ici < Len(.Text) Then .SelStart = Len(.Text): cod = 0: Exit Sub
If cod = 8 Then
If ici = 3 Or ici = 6 Then .Text = Left(.Text, Len(.Text) - 1)
Exit Sub
End If
If cod = 37 And ici = 0 Then
If IsDate(.Tag) Then .Text = .Tag: cod = 0: Exit Sub
End If
If cod > 95 Then cr = Chr(cod - 48)
If ici = 3 Then Mid(drf, 1, 5) = IIf(cr = "0", "00" & sp & "01", "00" & sp & "02")
dtt = .Text & cr & Mid(drf, ici + 2)
If cod = 32 Then
If ici = 0 Or ici = 3 Or ici = 6 Or ici = 8 Then
Dim voir As String
voir = .Text & Mid(Format(Date, "dd" & sp & "mm" & sp & "yyyy"), ici + 1)
If IsDate(voir) Then .Text = voir
End If
cod = 0: Exit Sub
End If
If ici <> 8 Then
If Not IsDate(dtt) Or Not dtt Like flt Then cod = 0: Exit Sub
Else
If Not IsNumeric(cr) Then cod = 0: Exit Sub
End If
Select Case ici
Case 1, 4
If ici = 4 And Val(Mid(.Text, ici, 1) & cr) > 12 Then cod = 0: Exit Sub
If ici = 4 And scl Then
.Text = Left(dtt, Len(.Text & cr)) & sp & Int(Year(Date) / 100): cod = 0
Else
.Text = Left(dtt, Len(.Text & cr)) & sp: cod = 0
End If
Case 3
If cr > "1" Then cod = 0
End Select
End With
Application.CutCopyMode = True
End Sub
Public Sub alarme(f As UserForm, t As MSForms.TextBox, ByRef c As MSForms.ReturnBoolean)
Dim debut As Double, Msg_date As String
If t.Text <> "" And Len(t.Text) < 10 Then
c = True
With f.Msg_date
.Move t.Left - 20, t.Top - 10, t.Width + 40, 60
.ZOrder
.Font.Name = "MS Sans Serif"
.Font.Bold = True
.Font.Size = 9
.Caption = "la date doit être sous la forme jj/mm/aaaa avec un millésime sur 4 chiffres)"
.BackColor = vbYellow
.ForeColor = vbRed
.TextAlign = fmTextAlignCenter
.Visible = True
debut = Timer
Do While Timer < debut + 4
DoEvents
Loop
.Visible = False
End With
Else
If t.Text <> "" Then t.Tag = t.Text
End If
End Sub
Su ton userform (fais tes tests sur un nouvel userform) :
- 3 textboxes : T-date1, T_date2 et T_date3
- un label Msg_date avec sa propriété visible = False
- un bouton de commande CommandButton1, qui n'est là que pour te permettre de tester ce que donne la flèche gauche après effacements (comme expliqué plus haut)
- ce code :
Option Explicit
Private Sub CommandButton1_Click()
' juste pour tout effacer toutes tes textboxes et tester
Dim i As Byte
For i = 1 To 3
Me.Controls("T_date" & i).Text = ""
Next
End Sub
Private Sub T_date1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
alarme Me, ActiveControl, Cancel
End Sub
Private Sub T_date1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
teste_date ActiveControl, KeyCode, "##/##/####", True
End Sub
Private Sub T_date2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
alarme Me, ActiveControl, Cancel
End Sub
Private Sub T_date2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
teste_date ActiveControl, KeyCode, "## ## ####", False
End Sub
Private Sub T_date3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
alarme Me, ActiveControl, Cancel
End Sub
Private Sub T_date3_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
teste_date ActiveControl, KeyCode, "##-##-####", False
End Sub
Lance, amuse-toi ... tu vas tout comprendre.
________________________
Nul ne saurait valablement coder ce qu'il ne saurait exposer clairement.
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
211
Modifié par ucfoutu le 31/01/2016 à 23:29
Modifié par ucfoutu le 31/01/2016 à 23:29
Le "plus mieux" étant dans ce domaine d'obliger l'utilisateur à saisir avec soin sous la forme "jj/mm/aaaa" en rajoutant implement une condition, ainsi ===>>>
Que tu pourrais d'ailleurs écrire du coup ainsi également :
N'oublie pas le clic sur RESOLU (tu le peux, puisque tu t'es cette fois-ci "loggé".
________________________
Nul ne saurait valablement coder ce qu'il ne saurait exposer clairement.
MsgBox IsDate(TextBox1.Value) And Split(TextBox1.Text, "/")(1) <= 12 And TextBox1.Text Like "##/##/####"
Que tu pourrais d'ailleurs écrire du coup ainsi également :
MsgBox IsDate(TextBox1.Value) And TextBox1.Text Like "##/##/####" And Val(Mid(TextBox1.Text, 4, 2)) < 13
N'oublie pas le clic sur RESOLU (tu le peux, puisque tu t'es cette fois-ci "loggé".
________________________
Nul ne saurait valablement coder ce qu'il ne saurait exposer clairement.
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
211
31 janv. 2016 à 22:50
31 janv. 2016 à 22:50
Bonjour, la fonction Isdate permet de vérifier la validité d'une date
et donc :
Attention, toutefois : VBA/EXCEL reconnait comme date, par exemple : 12/31/2000, qu'il interprétera comme étant le 31/12/2000.
Si tu veux forcer la date au format dd/mm/yyyy, il te suffit de vérifier que le mois n'est en plus pas supérieur à 12 ===>>Q
regarde ===>>
et donc :
Msgbox isdate(textbox1.value)===>> True si date , false sinon
Attention, toutefois : VBA/EXCEL reconnait comme date, par exemple : 12/31/2000, qu'il interprétera comme étant le 31/12/2000.
Si tu veux forcer la date au format dd/mm/yyyy, il te suffit de vérifier que le mois n'est en plus pas supérieur à 12 ===>>Q
regarde ===>>
MsgBox IsDate(TextBox1.Value) And Split(TextBox1.Text, "/")(1) <= 12
NHenry
Messages postés
15113
Date d'inscription
vendredi 14 mars 2003
Statut
Modérateur
Dernière intervention
22 avril 2024
159
31 janv. 2016 à 22:50
31 janv. 2016 à 22:50
Regardes la fonction IsDate.
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
aminesc
Messages postés
70
Date d'inscription
dimanche 25 octobre 2015
Statut
Membre
Dernière intervention
3 juillet 2017
31 janv. 2016 à 22:59
31 janv. 2016 à 22:59
OK merci beaucoup pour votre aide
aminesc
Messages postés
70
Date d'inscription
dimanche 25 octobre 2015
Statut
Membre
Dernière intervention
3 juillet 2017
1 févr. 2016 à 13:42
1 févr. 2016 à 13:42
Bonjour,
j'ai esseyer se code mais sa marche pas
if (MsgBox IsDate(date_depense.Value) And date_depense.Text Like "##/##/##" And Val(Mid(date_depense.Text, 4, 2)) < 13)=false then
MsgBox "Erreure saise date" & Chr(10) & "EX: jj/mm/aaaa "
END IF
j'ai esseyer se code mais sa marche pas
if (MsgBox IsDate(date_depense.Value) And date_depense.Text Like "##/##/##" And Val(Mid(date_depense.Text, 4, 2)) < 13)=false then
MsgBox "Erreure saise date" & Chr(10) & "EX: jj/mm/aaaa "
END IF
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
211
Modifié par ucfoutu le 1/02/2016 à 17:08
Modifié par ucfoutu le 1/02/2016 à 17:08
Bien évidemment que non ...
Le msgbox n 'était dans cet exemple que pour te montrer !
Si tu veux l'utiliser dans ton code avec condition, c'est avec une syntaxe du genre :
le mieux est sans doute d'utiliser l'évènement Exit de ta textbox, ainsi, par exemlple
De cette manière, l'utilisateur recevra un message et sera "reconduit à la textbox, chaque fois qu'il voudra aller ailleurs sur ton userform après cette textbox.
Observation : il n'est pas prudent de ne pas être exigeant en ce qui concerne le millésime. Oblige les 4 chiffres. (Rappelle-toi le "bug de l'an 2000" ...). Va donc savoir autrement si 01/01/50 est le 01/01/2050 ou le 01/01/1950 !!!
________________________
Nul ne saurait valablement coder ce qu'il ne saurait exposer clairement.
Le msgbox n 'était dans cet exemple que pour te montrer !
Si tu veux l'utiliser dans ton code avec condition, c'est avec une syntaxe du genre :
If IsDate(date_depense.Value) And date_depense.Text Like "##/##/####" And Val(Mid(date_depense.Text, 4, 2)) < 13 Then
MsgBox "date valide" '====>> remplace par tes instructions ou rien
Else
MsgBox "date non valide" '====>>> remplace par tes instructions (par exemple : message et retour sur la textbox
End If
le mieux est sans doute d'utiliser l'évènement Exit de ta textbox, ainsi, par exemlple
Private Sub depense.Text_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If depense.Text.Text = "" Then Exit Sub ' supprime cette ligne si tu veux obliger à saisir, en plus
If IsDate(depense.Text.Value) And depense.Text.Text Like "##/##/####" And Val(Mid(depense.Text.Text, 4, 2)) < 13 Then Exit Sub
MsgBox "la date doit être valide et à saisir obligatoirement sous la forme jj/mm/aaaa"
Cancel = True
End Sub
De cette manière, l'utilisateur recevra un message et sera "reconduit à la textbox, chaque fois qu'il voudra aller ailleurs sur ton userform après cette textbox.
Observation : il n'est pas prudent de ne pas être exigeant en ce qui concerne le millésime. Oblige les 4 chiffres. (Rappelle-toi le "bug de l'an 2000" ...). Va donc savoir autrement si 01/01/50 est le 01/01/2050 ou le 01/01/1950 !!!
________________________
Nul ne saurait valablement coder ce qu'il ne saurait exposer clairement.
aminesc
Messages postés
70
Date d'inscription
dimanche 25 octobre 2015
Statut
Membre
Dernière intervention
3 juillet 2017
2 févr. 2016 à 00:01
2 févr. 2016 à 00:01
Bonsoir,
ok sa marche très bien mais j'ai un petit souci , la date saisie dans mon textbox ex: 07/08/2003 dans la cellule affecter je trouve 08/07/2003 inversion mois et jour , je c pas pour quoi ?????
ok sa marche très bien mais j'ai un petit souci , la date saisie dans mon textbox ex: 07/08/2003 dans la cellule affecter je trouve 08/07/2003 inversion mois et jour , je c pas pour quoi ?????
vb95
Messages postés
3473
Date d'inscription
samedi 11 janvier 2014
Statut
Contributeur
Dernière intervention
30 avril 2024
169
Modifié par vb95 le 2/02/2016 à 01:16
Modifié par vb95 le 2/02/2016 à 01:16
Bonjour
Lu dans divers forums ( à vérifier car je n'ai pas Excel )
Lorsque on travaille en mode Developpeur sous VBA le tableur Excel travaille avec les dates au format américain : mm/jj/aaaa
Le mois est avant le jour et les affichages dans les TextBox se font en format américain
Lu dans divers forums ( à vérifier car je n'ai pas Excel )
Lorsque on travaille en mode Developpeur sous VBA le tableur Excel travaille avec les dates au format américain : mm/jj/aaaa
Le mois est avant le jour et les affichages dans les TextBox se font en format américain
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
211
Modifié par ucfoutu le 2/02/2016 à 07:11
Modifié par ucfoutu le 2/02/2016 à 07:11
Bonjour (et un salut à VB95),
On s'écarte là complètement du sujet, aminesc !
Le sujet était : comment vérifier la validité d'une date saisie dans une textbox sur un userform.
Tu as eu ta réponse ...
Rien à voir avec l'affichage, ensuite, de cette date dans une cellule, qui est un problème d'un tout autre ordre, que cette date provienne de ta textbox ou qu'elle soit le contenu d'une variable texte quelconque !
Tu connais le principe (je te l'ai rappelé dans ton autre discussion) : difficulté distincte = discussion distincte - problème résolu = discussion à libérer
Je vais donc me contenter de te dire que cette AUTRE difficulté à résoudre n'a rien à voir avec ta saisie et tout à voir avec tes paramètres régionaux et le formatage des cellules. Je ne serai plus complet sur cet aspect-là que dans une discussion ad hoc et non dans la présente.
________________________
Nul ne saurait valablement coder ce qu'il ne saurait exposer clairement.
On s'écarte là complètement du sujet, aminesc !
Le sujet était : comment vérifier la validité d'une date saisie dans une textbox sur un userform.
Tu as eu ta réponse ...
Rien à voir avec l'affichage, ensuite, de cette date dans une cellule, qui est un problème d'un tout autre ordre, que cette date provienne de ta textbox ou qu'elle soit le contenu d'une variable texte quelconque !
Tu connais le principe (je te l'ai rappelé dans ton autre discussion) : difficulté distincte = discussion distincte - problème résolu = discussion à libérer
Je vais donc me contenter de te dire que cette AUTRE difficulté à résoudre n'a rien à voir avec ta saisie et tout à voir avec tes paramètres régionaux et le formatage des cellules. Je ne serai plus complet sur cet aspect-là que dans une discussion ad hoc et non dans la présente.
________________________
Nul ne saurait valablement coder ce qu'il ne saurait exposer clairement.
aminesc
Messages postés
70
Date d'inscription
dimanche 25 octobre 2015
Statut
Membre
Dernière intervention
3 juillet 2017
2 févr. 2016 à 09:38
2 févr. 2016 à 09:38
Bonjour,
un autre problème une autre question ok ok
un autre problème une autre question ok ok
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
211
Modifié par ucfoutu le 3/02/2016 à 08:38
Modifié par ucfoutu le 3/02/2016 à 08:38
Bonjour,
Voilà un petit cadeau très matinal pour toi :
Crée un nouvel userform (peu importe, c'est juste pour voir et comprendre)
mets-y une textbox nommée t_date (celle qui va servir à saisir une date)
mets-y où tu veux (le code va le replacer) un label nommé Msg_date invisible (propriété visible = false)
mets-y un ou deux autres contrôles de ton choix (ce que tu veux)
et ce code :
Lance et fais joujou avec cela. Tu vas très vite comprendre le confort
Il est clair que les deux procédures après le trait "=========="
sont utilisables pour toute autre textbox additionnelle éventuelle de date à contrôler (en te précisant que tu n'as aucun autre label d'alarme à créer dans ce cas. Le même sert pour tout)
EDIT : attends ... je viens de découvrir un tout petit bug très facile à corriger sur certaines années bissextiles. Je vais le corriger au retour de ma partie de pêche et en profiterai pour y ajouter une touche de confort supplémentaire (ajout d'un paramètre qui, si à True , saisit en plus automatiquement les deux premiers chiffres du millésime en cours)
A +, donc (vers 11 heures)
________________________
Nul ne saurait valablement coder ce qu'il ne saurait exposer clairement.
EDIT 2 :
Tiens (suis en forme, ce matin) ===>> bug déjà corrigé + ajout du petit confort supplémentaire optionnel dont je te parlais.
Regarde la différence en appelant avec True ou avec False dans
teste_date ActiveControl, KeyCode, "##/##/####", True
tu vas vite comprendre.
Voilà un petit cadeau très matinal pour toi :
Crée un nouvel userform (peu importe, c'est juste pour voir et comprendre)
mets-y une textbox nommée t_date (celle qui va servir à saisir une date)
mets-y où tu veux (le code va le replacer) un label nommé Msg_date invisible (propriété visible = false)
mets-y un ou deux autres contrôles de ton choix (ce que tu veux)
et ce code :
Option Explicit
Private Sub T_date_Exit(ByVal Cancel As MSForms.ReturnBoolean)
alarme ActiveControl, Cancel
End Sub
Private Sub T_date_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'tu peux aussi (selon ton gôut) utiliser "##/##/####","##-##-####" ou "## ## ####"
teste_date ActiveControl, KeyCode, "##/##/####"
End Sub
'========================================
Private Sub teste_date(ByRef t As MSForms.TextBox, ByRef cod As MSForms.ReturnInteger, ByVal flt As String)
Dim ici As Byte, sp As String, cr As String, drf As String, dtt As String
Application.CutCopyMode = False
sp = Left(Replace(flt, "#", ""), 1)
drf = "31" & sp & "12" & sp & "2000" 'ne touche jamais rien à cette chaine
With t
ici = .SelStart
If ici < Len(.Text) Then
.SelStart = Len(.Text): cod = 0: Exit Sub
End If
If cod = 8 Then
If ici = 3 Or ici = 6 Then .Text = Left(.Text, Len(.Text) - 1)
Exit Sub
End If
If cod > 95 Then cr = Chr(cod - 48)
If ici = 3 Then Mid(drf, 1, 5) = IIf(cr = "0", "00" & sp & "01", "00" & sp & "02")
dtt = .Text & cr & Mid(drf, ici + 2)
If Not IsDate(dtt) Or Not dtt Like flt Then cod = 0: Exit Sub
Select Case ici
Case 1, 4
If ici = 4 And Val(Mid(.Text, ici, 1) & cr) > 12 Then cod = 0: Exit Sub
.Text = Left(dtt, Len(.Text & cr)) & sp: cod = 0
Case 3
If cr > "1" Then cod = 0
End Select
End With
Application.CutCopyMode = True
End Sub
Private Sub alarme(t As MSForms.TextBox, ByRef c As MSForms.ReturnBoolean)
Dim debut As Double
If t.Text <> "" And Len(t.Text) < 10 Then
c = True
With Msg_date
.Move t.Left - 20, t.Top - 20, t.Width + 40, 60
.ZOrder
.Font.Name = "MS Sans Serif"
.Font.Bold = True
.Font.Size = 10
.Caption = "la date doit être sous la forme jj/mm/aaaa avec un millésime sur 4 chiffres)"
.BackColor = vbYellow
.ForeColor = vbRed
.TextAlign = fmTextAlignCenter
.Visible = True
debut = Timer
Do While Timer < debut + 4
DoEvents
Loop
.Visible = False
End With
End If
End Sub
Lance et fais joujou avec cela. Tu vas très vite comprendre le confort
Il est clair que les deux procédures après le trait "=========="
sont utilisables pour toute autre textbox additionnelle éventuelle de date à contrôler (en te précisant que tu n'as aucun autre label d'alarme à créer dans ce cas. Le même sert pour tout)
EDIT : attends ... je viens de découvrir un tout petit bug très facile à corriger sur certaines années bissextiles. Je vais le corriger au retour de ma partie de pêche et en profiterai pour y ajouter une touche de confort supplémentaire (ajout d'un paramètre qui, si à True , saisit en plus automatiquement les deux premiers chiffres du millésime en cours)
A +, donc (vers 11 heures)
________________________
Nul ne saurait valablement coder ce qu'il ne saurait exposer clairement.
EDIT 2 :
Tiens (suis en forme, ce matin) ===>> bug déjà corrigé + ajout du petit confort supplémentaire optionnel dont je te parlais.
Option Explicit
Private Sub T_date_Exit(ByVal Cancel As MSForms.ReturnBoolean)
alarme ActiveControl, Cancel
End Sub
Private Sub T_date_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'tu peux aussi (selon ton gôut) utiliser "##/##/####","##-##-####" ou "## ## ####"
teste_date ActiveControl, KeyCode, "##/##/####", True
End Sub
Private Sub teste_date(ByRef t As MSForms.TextBox, ByRef cod As MSForms.ReturnInteger, ByVal flt As String, scl As Boolean)
Dim ici As Byte, sp As String, cr As String, drf As String, dtt As String, siecle As Boolean
'siecle = True
Application.CutCopyMode = False
sp = Left(Replace(flt, "#", ""), 1)
drf = "31" & sp & "12" & sp & "2000" 'ne touche jamais rien à cette chaine
With t
ici = .SelStart
If ici < Len(.Text) Then
.SelStart = Len(.Text): cod = 0: Exit Sub
End If
If cod = 8 Then
If ici = 3 Or ici = 6 Then .Text = Left(.Text, Len(.Text) - 1)
Exit Sub
End If
If cod > 95 Then cr = Chr(cod - 48)
If ici = 3 Then Mid(drf, 1, 5) = IIf(cr = "0", "00" & sp & "01", "00" & sp & "02")
dtt = .Text & cr & Mid(drf, ici + 2)
If ici <> 8 Then
If Not IsDate(dtt) Or Not dtt Like flt Then cod = 0: Exit Sub
Else
If Not IsNumeric(cr) Then cod = 0: Exit Sub
End If
Select Case ici
Case 1, 4
If ici = 4 And Val(Mid(.Text, ici, 1) & cr) > 12 Then cod = 0: Exit Sub
If ici = 4 And scl Then
.Text = Left(dtt, Len(.Text & cr)) & sp & Int(Year(Date) / 100): cod = 0
Else
.Text = Left(dtt, Len(.Text & cr)) & sp: cod = 0
End If
Case 3
If cr > "1" Then cod = 0
End Select
End With
Application.CutCopyMode = True
End Sub
Private Sub alarme(t As MSForms.TextBox, ByRef c As MSForms.ReturnBoolean)
Dim debut As Double
If t.Text <> "" And Len(t.Text) < 10 Then
c = True
With Msg_date
.Move t.Left - 20, t.Top - 20, t.Width + 40, 60
.ZOrder
.Font.Name = "MS Sans Serif"
.Font.Bold = True
.Font.Size = 10
.Caption = "la date doit être sous la forme jj/mm/aaaa avec un millésime sur 4 chiffres)"
.BackColor = vbYellow
.ForeColor = vbRed
.TextAlign = fmTextAlignCenter
.Visible = True
debut = Timer
Do While Timer < debut + 4
DoEvents
Loop
.Visible = False
End With
End If
End Sub
Regarde la différence en appelant avec True ou avec False dans
teste_date ActiveControl, KeyCode, "##/##/####", True
tu vas vite comprendre.
aminesc
Messages postés
70
Date d'inscription
dimanche 25 octobre 2015
Statut
Membre
Dernière intervention
3 juillet 2017
3 févr. 2016 à 23:18
3 févr. 2016 à 23:18
bonsoir ucfoutu,
je vient de lire ta reponce merci beaucoup ,je vais essayer de déchiffré , c'est très simpa de ta par think
je vient de lire ta reponce merci beaucoup ,je vais essayer de déchiffré , c'est très simpa de ta par think
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
211
4 févr. 2016 à 00:15
4 févr. 2016 à 00:15
Bon ...
Ce n'est pas mon code qui, dans cette affaire, est compliqué, mais la "démarche" de la pensée. Tel est d'ailleurs souvent le cas.
Reviens demain regarder cette discussion.
Tu y trouveras la toute dernière mouture que je viens de terminer.
Je lui ai ajoutée d'autres petits conforts très appréciables. Tu verras.
A demain
Ce n'est pas mon code qui, dans cette affaire, est compliqué, mais la "démarche" de la pensée. Tel est d'ailleurs souvent le cas.
Reviens demain regarder cette discussion.
Tu y trouveras la toute dernière mouture que je viens de terminer.
Je lui ai ajoutée d'autres petits conforts très appréciables. Tu verras.
A demain
aminesc
Messages postés
70
Date d'inscription
dimanche 25 octobre 2015
Statut
Membre
Dernière intervention
3 juillet 2017
Modifié par aminesc le 4/02/2016 à 12:14
Modifié par aminesc le 4/02/2016 à 12:14
Bonjour,
voici se que j'ai fait normalement sa marche ,
Private Sub date_depense_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(date_depense.Value) And date_depense.Text Like "##/##/####" And Val(Mid(date_depense.Text, 4, 2)) < 13 Then
' forma de date corecte ==> ne rien faire
Else
MsgBox "la date doit être valide et à saisir obligatoirement sous la forme jj/mm/aaaa"
End If
End Sub
voici se que j'ai fait normalement sa marche ,
Private Sub date_depense_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(date_depense.Value) And date_depense.Text Like "##/##/####" And Val(Mid(date_depense.Text, 4, 2)) < 13 Then
' forma de date corecte ==> ne rien faire
Else
MsgBox "la date doit être valide et à saisir obligatoirement sous la forme jj/mm/aaaa"
End If
End Sub
aminesc
Messages postés
70
Date d'inscription
dimanche 25 octobre 2015
Statut
Membre
Dernière intervention
3 juillet 2017
4 févr. 2016 à 12:17
4 févr. 2016 à 12:17
dans le meme userform j'ai aussi une liste deroulante j'ai essayer de faire la meme chose , voici se qu ej'ai fait , mais sa marche pas ;
le ComboBox1 = caisse
Private Sub caisse_Exit(ByVal Cancel As MSForms.ReturnBoolean)
valeur = "=VLookup(""" & caisse.Text & """, caisse, 2, False)"
If valeur = "#N/A" Then
MsgBox "client nexiste ps"
End If
Range("B1") = "=VLookup(""" & caisse.Text & """, caisse, 2, False)"
End Sub
le ComboBox1 = caisse
Private Sub caisse_Exit(ByVal Cancel As MSForms.ReturnBoolean)
valeur = "=VLookup(""" & caisse.Text & """, caisse, 2, False)"
If valeur = "#N/A" Then
MsgBox "client nexiste ps"
End If
Range("B1") = "=VLookup(""" & caisse.Text & """, caisse, 2, False)"
End Sub
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
211
4 févr. 2016 à 12:21
4 févr. 2016 à 12:21
Tu connais d'avance ma réaction, non ?
Je ne mélange jamais la résolution de choses différentes dans la même discussion....
Je ne mélange jamais la résolution de choses différentes dans la même discussion....
aminesc
Messages postés
70
Date d'inscription
dimanche 25 octobre 2015
Statut
Membre
Dernière intervention
3 juillet 2017
>
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
Modifié par aminesc le 4/02/2016 à 12:29
Modifié par aminesc le 4/02/2016 à 12:29
c'est juste presque le même problème ; mais okokokoko
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
211
>
aminesc
Messages postés
70
Date d'inscription
dimanche 25 octobre 2015
Statut
Membre
Dernière intervention
3 juillet 2017
4 févr. 2016 à 16:29
4 févr. 2016 à 16:29
ni de près, ni même de très loin .... quelle que puisse être ton "impression".
La seule "chose" de commune est l'affichage d'un message. Rien de tout le reste ...
C'est d'ailleurs ce dont tu vas te rendre compte dans la discussion que tu as ouverte à ce sujet.
La seule "chose" de commune est l'affichage d'un message. Rien de tout le reste ...
C'est d'ailleurs ce dont tu vas te rendre compte dans la discussion que tu as ouverte à ce sujet.
aminesc
Messages postés
70
Date d'inscription
dimanche 25 octobre 2015
Statut
Membre
Dernière intervention
3 juillet 2017
4 févr. 2016 à 23:06
4 févr. 2016 à 23:06
OK