Vérification du format de la date

Version imprimable

Voir 40 message(s) de cette discussion en une page

Bonjour,

J'ai un souci avec la fonction de vérification car si je met 45/14/19 avec le format dd/mm/yy, le format de la date passe sans message d'erreur

Voici mon code
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 Private Sub TextBox5_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 13 Then If IsDate(TextBox5.Value) And TextBox5.Value Like "##/##/##" Then TextBox18.Enabled = True TextBox18.BackColor = RGB(255, 255, 255) Else MsgBox "Entrer une date valide" TextBox5.Value = "" Me.TextBox5.SetFocus End If End If End Sub
Petite Question bonus : pourquoi je ne reviens pas à mon TextBox5 avec le SetFocus?

Seconde question bonus : y as-t-il possibilité d'afficher un calendrier lors de la saisie de la date quand elle n'est pas valide?

Merci d'avance.

10/01/2019, 21h43
unparia

https://www.developpez.net/forums/d1.../#post10694828
10/01/2019, 21h57
Nico451

J'ai fait une grosse bêtise. Comment je peux faire pour y remédier?

Mais ce matin j'ai poser une question dans un post qui été résolu et ce soir je ne le trouve plus c'est pour ça que j'ai crée un autre post.
11/01/2019, 08h51
Menhir

Citation:

Envoyé par Nico451

si je met 45/14/19 avec le format dd/mm/yy, le format de la date passe sans message d'erreur

C'est un peu logique puisque, à ma connaissance, aucun mois n'a de jour 45 et aucune année n'a de mois 14.

bonjour
si tu veux garder le focus sur le textbox5 en erreur de date msgbox ou pas il te faut annuler le keycode(13)

un petit exemple
Code:

1 2 3 4 5 6 7 8 9 10 Private Sub TextBox5_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 13 Then With TextBox5 If Not IsDate(.Value) And .Value Like "##/##/##" Then .Value = "": KeyCode = 0 MsgBox "Entrer une date valide" End If End With End If End Sub
Attention tout de meme au mois de "fevrier" le control "isdate" n'est pas suffisant
exemple si je tape "29/02/19" je passe au textbox suivant alors que la date n'est pas valide
en effet l'erreur ne sera pas relevée avec une date format "dd/mm/yy"

je te suggere donc d'approfondir ton test de validité avec dateserial et les elements du split de la chaine du textbox5 en comparant le day,month,year du resultat avec la chaine réelle je sais c'est con car c'est juste pour fevrier mais c'est comme ca si tu veux avoir un control de validité sans faille

Bonjour,

Essaies :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub TextBox5_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim b As Boolean
    If KeyCode = 13 Then
        b = IsDate(TextBox5.Value)
        If b Then b = Format(CDate(TextBox5.Value), "dd/mm/yy") = TextBox5.Value
        If b Then
            TextBox18.Enabled = True
            TextBox18.BackColor = RGB(255, 255, 255)
        Else
            MsgBox "Entrer une date valide"
            TextBox5.Value = "": KeyCode = 0
            Me.TextBox5.SetFocus
       End If
    End If
End Sub

11/01/2019, 15h49
patricktoulon

re

Bonjour patrick 740
le backcolor sur t18 c'est pas la peine car c'est impossible because focus sur t5 tant que le keyup n'est pas effectif sur celui
bien vu le test format =.value
testé sur 2007!!!
10/02/2019, 12h35
Nico451

Pas encore testé mais j'ai pris.

Merci du coup de main.

bonjour

une petite variante avec selection du texte dans textbox5 si c'est pas conforme
pratique en cas de non conformité pour retaper directement sans selectionner et supprimer

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub TextBox5_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim b As Boolean
    If KeyCode = 13 Then
        With TextBox5
            If IsDate(.Value) Then b = Format(CDate(.Value), "dd/mm/yy") = CStr(.Value)
            If b Then
                TextBox18.Enabled = b
                TextBox18.BackColor = IIf(b = True, RGB(255, 255, 255), .BackColor)
            Else
                KeyCode = 0: .SelStart = 0: .SelLength = 10
            End If
        End With
    End If
End Sub

une autre sans les if

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub TextBox5_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim b As Boolean
    If KeyCode = 13 Then
        With TextBox5
            If IsDate(.Value) Then b = Format(CDate(.Value), "dd/mm/yy") = CStr(.Value)
            '
            With TextBox18: .Enabled = b: .BackColor = IIf(Not b, .BackColor, RGB(255, 255, 255)): End With
            '
            '
            If Not b Then KeyCode = 0: .SelStart = 0: .SelLength = 10
            '
        End With
    End If
End Sub

10/02/2019, 15h09
omrsmiloud

1 pièce(s) jointe(s)

bonjour a tous

je reviens sur la Seconde question bonus de Nico451 , une petite calendrier que j'ai réalisé , et qui fonctionne parfaitement si ça peut vous être utile , et éviter ce genre de problèmes avec les dates

j'ai tous appris de ce merveilleux Forum que je me sens obligé de donner de mois aussi

Un grand merci a patricktoulon

bonne journée
10/02/2019, 16h17
patricktoulon

re

re
bonjour ormsmiloud
il est pas tres bien au point ton calendrier question manipulation les fleches marchent pas tres bien l'affichage manque du positionnement des jour

j'ai pas regardé ton code
j'en ai un a te proposer qui est aboutie et possede plusieur niveau de sortie
10/02/2019, 16h30
omrsmiloud

bonjour
OK
c'est quelque chose de débutant , est juste une contribution , pour ta proposition , j'en suis preneur bien sur

cdt
10/02/2019, 16h45
patricktoulon

re

voici le mien un fichier avec dvers utilisation dans des textbos et sheets

https://www.developpez.net/forums/bl...rso-episode-6/
10/02/2019, 18h05
OrDonc

1 pièce(s) jointe(s)

Bonjour,
sans trop vouloir compliquer la programmation ... tu reconnaîtras sans doute cette proposition, n'est-ce pas Patrick ?

edit : voir plus loin pour un exemple amélioré
10/02/2019, 18h35
patricktoulon

re

re
ca ressemble a ma facon de coder pour certaine lignes

cela dit 7 clicks pour mettre une date wouawhhouw !!!!

ordonc pour moi il y a un probleme ici

Code:

For n = 1 To 31: Cj.AddItem n: Next

y a pas toujours 31 jours
10/02/2019, 23h19
omrsmiloud

1 pièce(s) jointe(s)

bonsoir

bien sur la votre est bien rédigée ;

mais je crois que la première semaine janvier 2019 et bien la semaine "1" !!!!

Pièce jointe 448884
cdt

bonjour ordonc
oui j'ai vu merci du retour je vais corriger ca

pour la tienne je l'ai transformé en dialog

j'ai vré tes deux textbox et ton bouton rouge

remis la frame a gauche et diminué la largeur

j'ai viré tout ton code et garder quelques ligne + modif et ajout

voila ce que ca donne

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Option Explicit
Public dateusf As Variant
Public position As Object
Dim n As Long, F As Boolean
Private Sub UserForm_Activate()
    For n = 1 To 31: Cj.AddItem n: Next
    For n = 1 To 12: Cm.AddItem MonthName(n): Next
    For n = 2019 To 2050: Ca.AddItem n: Next
    Ca = "": Cm = "": Cj = ""
     If Not position Is Nothing Then
        Me.Top = Application.Top + 140 + ActiveWindow.Top + 18 + position.Top - (ActiveWindow.ScrollRow * 14)
        Me.Left = Application.Left + ActiveWindow.Left + 34 + position.Left + position.Width
    End If
End Sub
Private Sub Ca_Change()
    If Cm.ListIndex > 0 Then _
       Cj.Clear: For n = 1 To Day(DateSerial(Ca, Cm.ListIndex + 2, 1) - 1): Cj.AddItem n: Next
End Sub
Private Sub E_Click()
    dateusf = DateSerial(Val(Ca.Value), Val(Cm.ListIndex + 1), Val(Cj.Value)): Me.Hide
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = 0 Then Cancel = True: dateusf = False: Me.Hide
End Sub

maintenant dans un sheets

Code:

1
2
3
4
5
6
7
8
9
10
[
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Dim ladate
    Cancel = True
    If Target.Column = 1 And Target.Count = 1 Then
             With Usf: Set .position = Target: .Show: ladate = .dateusf: End With 'boite de dialog
    End If
    If ladate <> False Then Target.Value = ladate
    Unload Usf
End Sub

dans un module

Code:

1
2
3
4
Sub test()
With Usf: .Show: ladate = .dateusf: End With 'boite de dialog
MsgBox ladate
End Sub

c'est assez sommaire le positionnement c'est juste pour l'exemple
voila tu peux t'en servir n'importe ou dans un sheets ou dans un module

1 pièce(s) jointe(s)

Re
Merci Patrick pour tes remarques et ta proposition :).
Je me suis servi rapidement d'un exemple que j'avais donné dans une autre discussion (l'année passée, déjà ;)).
Bien sûr on peut améliorer la programmation avec une autre présentation (ListBox, SpinButton et utilisation d'une propriété peu utilisée Tag):
codes dans le formulaire :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Dim n As Byte, Dt As Date, C As Control
Private Sub UserForm_Initialize()
  For n = 1 To 12: Cm.AddItem MonthName(n): Next
  If ActiveCell.Address = "$E$12" Then   'réservé à la cellule E12
     For Each C In Me.Controls: C.Visible = C.Tag = "ç": Next
  End If
End Sub
Private Sub Cm_Click()
  If Cm <> "" Then Sj.Max = Day(DateSerial(Sj.Min, Cm.ListIndex + 2, 1) - 1): Sa = Sa.Min
End Sub
Private Sub Sa_Change()         'SpinButton de date1 à date2
  Ca = Sa: Sj.Max = Day(DateSerial(Ca, Cm.ListIndex + 2, 1) - 1): Sj = Sj.Max
End Sub
Private Sub Sj_Change()      'SpinButton de 1 à 28, 30,  31 selon le cas (voir ci-dessus)
  Cj = Sj:  E.Visible = Cj <> ""
End Sub
Private Sub E_Click()
  Dt = CDate(DateSerial(Val(Ca), Val(Cm.ListIndex + 1), Val(Cj)))
  If C5.Visible = False Then
    [E12] = Dt: Unload Me
  Else
    C5 = Dt: C6.SetFocus
  End If
End Sub

code dans l'onglet contenant le bouton Dte pour sa cellule E2 :

Code:

1
2
3
4
5
6
Private Sub Dte_Click()
   Quand.Show
End Sub
Private Sub Worksheet_SelectionChange(ByVal R As Range)
  If R.Address = "$E$12" And R.Count = 1 Then Quand.Show
End Sub

L'adaptation pour un autre lancement ne présente aucune difficulté d'ajout

11/02/2019, 12h40
patricktoulon

re

re
puré tu te complique bien la vie avec des spin et textboxs
des combo suffisent amplement
je voulais te le transformer en dialogue mais la non j'adere pas autant l'autre etait rigolo de simplicité autant celui la je l'utilise 3 fois je pete l'ordi avec la batte :ptdr:

fait en un correctement avec des combos proprement sans artifice enable et compagnie et fait en sorte que tout les jour soient visibles
cela dit question ergonomie je prefere le mien on a tout les jour du mois a porté de vue un calendrier quoi ?
et pour info j'ai corrigé la ligne dans le mien si ca t'interesse

Code:

If .Tag <> "" Then Me.Controls(CStr(.Tag)).Caption = DatePart("ww", DateSerial(comboYear.Value, Cb_Month.ListIndex, j), vbMonday, vbFirstJan1)

;)
11/02/2019, 13h17
unparia

Bonjour patrick

Code:

If .Tag <> "" Then Me.Controls(CStr(.Tag)).Caption = DatePart("ww", DateSerial(comboYear.Value, Cb_Month.ListIndex, j), vbMonday, vbFirstJan1)

Tu as là une drôle de manière d'utiliser la norme iso :D
Ainsi donc, pour toi et par exemple et entre autres, le 1er février 2016 serait dans la semaine N° 6 de l'année 2016 ?

Voir 40 message(s) de cette discussion en une page