Discussion :

[Nico451]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[unparia]

https://www.developpez.net/forums/d1.../#post10694828

[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.

[Menhir]

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.

[patricktoulon]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Patrice740]

Bonjour,

Essaies :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[patricktoulon]

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!!!

[Nico451]

Pas encore testé mais j'ai pris.

Merci du coup de main.

[patricktoulon]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[omrsmiloud]

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

[patricktoulon]

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

[omrsmiloud]

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

cdt

[patricktoulon]

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

https://www.developpez.net/forums/bl...rso-episode-6/

[OrDonc]

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é

[patricktoulon]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

y a pas toujours 31 jours

[omrsmiloud]

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" !!!!



cdt

[patricktoulon]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[OrDonc]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[patricktoulon]

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

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[unparia]

Bonjour patrick

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
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 ?