Discussion :

[Passepartout007]

Bonjour à tout,

J'ai formaliser un format d'un TextBox qui se nomme "MaDate" afin que l'on puissent rentré juste une date. Cette date par la suite est comparé à celle d'aujourd’hui et un Msgbox apparaît ou non suivant plusieurs possibilité.

je vous insert le code ici :

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
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
Const chainevide = "__/__/____"
Dim pointeur As Long
Dim chaine As Variant
 
Sub MSGbox1()
MsgBox "La date d'entrée ne respecte pas le Masque jj/mm/aaaa"
SendKeys "+{TAB}", False
End Sub
 
 
Private Sub MaDate_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Dim Ys As Integer, Ya As Integer, Ms As Integer, Ma As Integer, Js As Integer, Ja As Integer
 
Dim Dtoday As Date, Darrive As Date, Ddiff As Integer
If MaDate.Value = "__/__/____" Then Exit Sub
If InStr(1, MaDate.Value, "_") <> 0 Then Call MSGbox1
If InStr(1, MaDate.Value, "_") = 0 Then Call Verifdate
End Sub
 
Sub Verifdate()
Dtoday = Date
Darrive = MaDate.Value
Ddiff = DateDiff("d", Dtoday, Darrive)
 
If Ddiff < -20 Then
MsgBox "Attention la date saisie est enterieur à 20 jours"
SendKeys "+{TAB}", False
End If
If Ddiff > 30 Then MsgBox "Attention la date saisie est posterieur à 30 jours"
 
If Ddiff > -20 And Diff < 30 Then Exit Sub
 
 
End Sub
 
 
Private Sub userform_initialize()
MaDate.Text = chainevide
End Sub
 
Private Sub MaDate_change()
    chaine = ""
    For i = 1 To Len(MaDate)
        If IsNumeric(Mid(MaDate, i, 1)) Then chaine = chaine & Mid(MaDate, i, 1)
        If Len(chaine) = 2 Or Len(chaine) = 5 Then chaine = chaine & "/" ' attribue / entre les dd,mm,yy
    Next
    If Len(chaine) > 10 Then chaine = Left(chaine, 10)
    MaDate = chaine & Mid(chainevide, Len(chaine) + 1, 10 - Len(chaine) + 1)
 
    End Sub
 
Private Sub MaDate_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) ' positionne le cusseur au bonne endroit
    Dim ind As Long, X As String
    'Si le keycode = 8 soit backspace et que le Textox3 ne contient pas un chiffre de 0 a 9
    If KeyCode = 8 And Not MaDate Like "*0-9*" Then
        'Le keycode est zero
        KeyCode = 0
 
        'Ind = recherche de la position du  1er "_"  dispo dans le texte du textbox
        ind = InStr(1, MaDate, "_")
 
        'si ind = 0 alors il n'y a plus de "_" donc ind=len(textbox)
        If ind = 0 Then
            ind = Len(MaDate)
        Else
            'sinon ind = emplacement du "_" -1'oui!!!!
            ind = InStr(1, MaDate, "_") - 1
 
            'si le caractère suivant le "_" est "/", on retourne sur le caractère précédent!!!!! pas tout a fait comme ca qu'il faut l'interpréter
            If ind > 0 Then    'si la position ind est plus grand 0 oui!!!!
                'Si celui ci est égal à "-" alors ind = ind-1
                If Mid(MaDate, ind, 1) = "/" Then ind = ind - 1
            End If
        End If
        'si "_" n'est pas en position 0 alors X = texte entré, on cherche ensuite le "_" suivant dans X,
        'on passe au caractère suivant
        If ind <> 0 Then
            X = MaDate.Text: Mid(X, ind, 1) = "_": MaDate.Text = X
        End If
    End If
    'Si "_" n'est pas en position 0 alors le curseur va se placer sur le caractère précédent le dernier "_",
    'sinon sur le dernier caractère de la textbox
    MaDate.SelStart = IIf(ind <> 0, ind - 1, Len(MaDate))
End Sub
 
'Evalue la touche au moment où on la relache
Private Sub MaDate_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Dim l As String, ind As Long, X As String, Today As String, D As String
 
 
    'Si la touche retournée n'est pas numérique,alors elle est nulle et on sort de la fonction
    If Not IsNumeric(Chr(KeyAscii)) Then KeyAscii = 0: Exit Sub
    'De base, l renvoie la touche renvoyée. Elle est nulle au début
    l = Chr(KeyAscii): KeyAscii = 0
    'ind est la place du "_" dans la MaDate
    ind = InStr(1, MaDate, "_")
    'Si le "_" est en position 1 et que la touche renvoyée est supérieure à 3 alors la touche renvoyée est nulle
    'paramétrage jour
    If ind = 1 And l > 3 Then KeyAscii = 0: Exit Sub
    If ind = 2 And Mid(MaDate, 1, 1) = 3 And l > 1 Then KeyAscii = 0: Exit Sub
    If ind = 2 And Mid(MaDate, 1, 1) = 0 And l < 1 Then KeyAscii = 0: Exit Sub
    'paramétrage mois
    If ind = 4 And l > 1 Then KeyAscii = 0: Exit Sub
    If ind = 5 And Mid(MaDate, 4, 1) = 1 And l > 2 Then KeyAscii = 0: Exit Sub
    If ind = 5 And Mid(MaDate, 4, 1) = 0 And l < 1 Then KeyAscii = 0: Exit Sub
 
 
    'Le code ci dessus te donne la possibilité de traiter via des jours. Je lui ai dit avec les deux lignes du dessus
    'que le premier caractère ne peut être au dessus de 3 (on ne peut pas aller au delà du 31).
 
     'si ind est different de zero x=textbox.text:on remplace le  (ind)eme caractere par un dans la variable x:on met la chaine x dans le textbox
    If ind <> 0 Then: X = MaDate.Text: Mid(X, ind, 1) = l: MaDate.Text = X
 
    'si le textbox contient un "_"
    If MaDate Like "*_*" Then
        'On recherche la position du  "_" oui!!!
        ind = InStr(1, MaDate, "_")
        'Et si la position du "_" n'est pas 0 alors on place le curseur sur l'emplacement précédent, oui!!!!
        'Sinon sur le dernier caractere de la MaDate
        MaDate.SelStart = IIf(ind <> 0, ind - 1, Len(MaDate))
    End If
 
End Sub

Ce code à été principalement inspiré de ce que j'ai trouver sur internet. il fonctionne comme je l'entend. Cependant je voudrais appliquer tout se code à d'autre TextBox (au moin 10 autre) du même format avec un name identique ou presque "MaDate1", 'Madate2". (ici je prend un exemple)
C'est ici ou je bloque. Après recherche j'ai eu connaissance des Module de classe qui m'ont semblé bien utile dans se cas la.
J'ai donc créer un TextBox "MaDate1" et un Textbox "Madate2"
j'ai ensuite créer le module de classe "MaDate" où j'ai écris le code suivant :

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
 
' Objet Textbox source des événements
Public WithEvents oTextbox As MSForms.TextBox
 
' Sur changement de la TextBox
Private Sub oTextBox_Change()
' Notifie l'événement au formulaire parent de la textbox
oTextbox.Parent.MaDate_change oTextbox
 
End Sub
Private Sub oTextBox_Exit(ByVal Cancel As MSForms.ReturnBoolean)
oTextbox.Parent.MaDate_Exit oTextbox
End Sub
Private Sub oTextBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
oTextbox.Parent.MaDate_KeyDown oTextbox
End Sub
 
Private Sub oTextBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
oTextbox.Parent.MaDate_KeyPress oTextbox
End Sub
Sub oTextBox_clic()
oTextbox.Parent.Madate_clic oTextbox
End Sub

Par la suite dans l'userform1 (ou se trouve les TextBox) j'ai déclaré :

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
Private Sub userform_initialize()
 
Dim loCtl As Control
Dim loTextBox As Madateclasse
' Initialise la collection
Set OTextboxes = New Collection
' Boucle sur les contrôles
For Each loCtl In Me.Controls
    If loCtl.Name Like "MaDate*" Then
        ' Nouvelle instance de classe
        Set loTextBox = New Madateclasse
        ' Initialise la TextBox dans l'instance de classe
        Set loTextBox.oTextbox = loCtl
        ' Ajoute l'instance de classe à la collection
        ' Etape importante pour qu'elle ne soit pas détruit ensuite
        OTextboxes.Add loTextBox
    End If
Next
 
End Sub

Je vois bien l'incrémentation des deux textbox MaDate 1 et 2 se faire dans le module de classe sauf que le format quand je lance l'userform1 avec F5 je ne retrouve pas le format dans les deux Textbox alors que tout etait parfais sans module de classe. /Help
Je peux vous joindre les fichier à votre demande mais je préfère que vous m'indiqué mes erreur afin que je puissent les modifier.

Je sais que cela représente un sacrée travail pour vous et je vous remercie par avance de votre aide. Il faut savoir que je début en VBA et que jusqu’à présent votre forum et les aide mon fournis l’ensemble des informations donc j'avais besoin. Cette fois-ci je ne comprend pas assez les informations pour les utilisé c'est pour cela que je vous demande de l'aide.

Cordialement,
Passepartout007

[Jean-Philippe André]

SAlut,

ton bloc suivant

Code :

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

1
2
3
If MaDate.Value = "__/__/____" Then Exit Sub
If InStr(1, MaDate.Value, "_") <> 0 Then Call MSGbox1
If InStr(1, MaDate.Value, "_") = 0 Then Call Verifdate

aurait-il pu être simplifié en utilisant plus simplement IsDate() ?

Pourquoi n'utilises-tu pas un dateTimePicker ?

[Passepartout007]

Bonsoir Jean-Phillipe André,

Tous d'abord merci pour la rapidité de ta réponse, et merci de m'aider dans ma démarche.
Effectivement j'ai simplifier avec isdate() et cela fonctionne exactement de la même manière.

Code :

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

1
2
3
4
 
If MaDate.Value = "__/__/____" Then Exit Sub
If IsDate(MaDate.Value) = False Then Call MSGbox1
If IsDate(MaDate.Value) = True Then Call Verifdate

Concernant la fonction dateTimePicker je ne connaissais pas cette fonction. Si j'ai bien compris elle permet de sélectionner la date à l'aide d'un calendrier ?
Cependant je préfère pour mon application une saisie manuel. (Je garde cette fonction en revenche dans un coin, elle me semble bien utile.)

Je reviens donc vers toi pour te redemander si il existe un moyen que plusieurs Texboxs fasse appel à des mêmes macro. Sachant que dans chaque nom de macros on retrouve le nom de la textbox.

Je reste à ta disposition pour t'apporter des informations complémentaires à mon problème.
Je peux également à ta demande joindre le fichier avec une Texbox qui fonctionne correctement ainsi que mon autre fichier avec deux textbox ou je n'arrive pas à lier les fonctions avec le module de classe.

Cordialement,
Passepartout007

[patricktoulon]

re
bonjour
prend un fichier vierge
met lui un userform
dans cet userform met 3 textboxs avec pour valeur "__/__/____" c'est important

dans le module du userform tu va metre l'evenement keydown de tes 3 textboxs comme suit
voila pour l'evenement keydown

Code :

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

1
2
3
4
5
6
7
8
9
Private Sub TextBox1_KeyDown(ByVal keycode As MSForms.ReturnInteger, ByVal Shift As Integer)
    control_saisie TextBox1, keycode
End Sub
Private Sub TextBox2_KeyDown(ByVal keycode As MSForms.ReturnInteger, ByVal Shift As Integer)
    control_saisie TextBox2, keycode
End Sub
Private Sub TextBox3_KeyDown(ByVal keycode As MSForms.ReturnInteger, ByVal Shift As Integer)
    control_saisie TextBox3, keycode
End Sub

maintenant la fonction commune de control de saisie

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
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Private Sub control_saisie(txt As Object, keycode)
    With txt
        t = .Text
        X = .SelStart
        Select Case keycode
        Case 13: Exit Sub
        Case 8
            .SelStart = X: keycode = 0:
            If X < 6 Then Mid(t, 4, 2) = "__": .Text = t: .SelStart = 2
            If X < 3 Then Mid(t, 1, 2) = "__": .Text = t: .SelStart = 0
            If X > 5 Then Mid(t, 7, 4) = "____": .Text = t: .SelStart = 5
        Case 46
            .SelStart = X: keycode = 0:
            If X < 3 Then Mid(t, 1, 2) = "__": .Text = t: .SelStart = 3
           If X >= 3 And X < 5 Then Mid(t, 4, 2) = "__": .Text = t: .SelStart = 6
             If X > 5 Then Mid(t, 7, 4) = "____": .Text = t: .SelStart = 0
        Case 96 To 105
            t = .Text
            X = .SelStart
            If .SelLength = 2 Then
                If Mid(t, X + 1, .SelLength) Like "*/*" Then keycode = 0: Exit Sub
                Mid(t, X + 1, 2) = Chr(keycode - 48) & "_": keycode = 0: .Text = t: .SelStart = X + 1: .SelLength = 0: Exit Sub
            End If
            If InStr(t, "_") = 0 And .SelLength = 0 Then keycode = 0
            t = .Text
            If InStr(1, t, "_") <> 0 Then Mid(t, InStr(1, t, "_")) = Chr(keycode - 48): keycode = 0
            If Val(Mid(t, 1, 1)) > 3 Then Mid(t, 1, 1) = "_"
            If Val(Mid(t, 1, 2)) > 31 Then Mid(t, 1, 2) = "__"
            If Val(Mid(t, 4, 1)) > 1 Then Mid(t, 4, 1) = "_"
            If Val(Mid(t, 4, 2)) > 12 Then Mid(t, 4, 1) = "__": keycode = 0: Exit Sub
            If InStr(1, t, "_") = 4 And Not IsDate(Mid(t, 1, 3) & "01/2000") Then Mid(t, 1, 2) = "__": .SelStart = 0
            If InStr(1, t, "_") = 7 And Not IsDate(Mid(t, 1, 6) & "2000") Then Mid(t, 4, 2) = "__": .SelStart = 3
            If Not t Like "*_*" And Not IsDate(Mid(t, 1, 6) & "2000") Then Mid(t, 4, 2) = "__": .Text = t
            If Not t Like "*_*" And Not IsDate(t) Then Mid(t, 7, 4) = "____"
            .Text = t: .SelStart = InStr(1, t, "_") - IIf(InStr(1, t, "_") = 0, 0, 1):
            Exit Sub
        Case Else: keycode = 0
        End Select
    End With
End Sub

voila tu a 3 textbox avec control de saisie et !!! masque dynamique ,et cela avec la meme fonction
sauf erreur ou oubli de ma part tune peux pas taper une date non valide
je te laisse decouvrir son comportement


propriéte:

1. la touche SUPPR efface le segement dans le quel tu te trouve et le curseur se positionne sur le segment suivant
2. la touche BACK(retour en arriere) c'est la meme chose que le curseur seplace dans le segment precedent
3. quand tu selectionne un segment complet (jour ou mois ou année) et que tu tape un chiffre le 1er chiffre du segment est remplacé et le suivant est supprimé et le curseur se met en position sur le suivant
4. quand tu tape un mois non valide (>12 ou non valide avec les jour il est effacé ex 31/13) alors 13 est effacé ou 31/04 alors 04 est effacé
5. pour le mois de fevrier c'est pareil sauf que ca va plus loin avec les année bissextiles 29/02/2001 alors 2001 est effacé
6. que aille en avant ou en arriere le masque est dynamique (voir demo animée ci dessus

[Passepartout007]

Bonjour patricktoulon,

J'admire le travail que tu à fais cela fonctionne parfaitement ! Quand je vois la longueur de ton code et la longueur du miens j'ai encore de l’efficacité à mettre en oeuvre.

Je reviens juste vers toi pour savoir comment intégrer mes msgboxs d’avertissement à la sortie du textbox.

Le code qui fais les conditions des textboxs

Code :

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

1
2
3
4
5
6
7
8
Private Sub MaDate_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Dim Ys As Integer, Ya As Integer, Ms As Integer, Ma As Integer, Js As Integer, Ja As Integer
 
Dim Dtoday As Date, Darrive As Date, Ddiff As Integer
If MaDate.Value = "__/__/____" Then Exit Sub
If IsDate(MaDate.Value) = False Then Call MSGbox1
If IsDate(MaDate.Value) = True Then Call Verifdate
End Sub

Le code de la texte box Verifdate :

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
Sub Verrifdate()
Dtoday = Date
Darrive = MaDate.Value
Ddiff = DateDiff("d", Dtoday, Darrive)
 
If Ddiff < -20 Then
MsgBox "Attention la date saisie est enterieur à 20 jours"
SendKeys "+{TAB}", False
End If
If Ddiff > 30 Then MsgBox "Attention la date saisie est posterieur à 30 jours"
 
If Ddiff > -20 And Diff < 30 Then Exit Sub
 
 
End Sub

et le code de la Textbox MSGbox1

Code :

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

1
2
3
4
Sub MSGbox1()
MsgBox "La date d'entrée ne respecte pas le Masque jj/mm/aaaa"
SendKeys "+{TAB}", False
End Sub

Encore merci pour ce magnifique code je cela va m'enlever un gros travail de saisie et rentre plus claire mon code. (oui je ne fais que débuter en VBA ça ce vois )
Je reste preneur d'autre conseil ou explication du détails des codes.

Cordialement,

Matthieu Delmont

[patricktoulon]

re
tape ta date et quand il y a plus de "_" alors elle est complete et boom verif date
je te laisse reecrire ta sub verif

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
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Private Sub control_saisie(txt As Object, keycode)
    With txt
        t = .Text
        X = .SelStart
        Select Case keycode
        Case 13: Exit Sub
        Case 8
            .SelStart = X: keycode = 0:
            If X < 6 Then Mid(t, 4, 2) = "__": .Text = t: .SelStart = 2
            If X < 3 Then Mid(t, 1, 2) = "__": .Text = t: .SelStart = 0
            If X > 5 Then Mid(t, 7, 4) = "____": .Text = t: .SelStart = 5
        Case 46
            .SelStart = X: keycode = 0:
            If X < 3 Then Mid(t, 1, 2) = "__": .Text = t: .SelStart = 3
           If X >= 3 And X < 5 Then Mid(t, 4, 2) = "__": .Text = t: .SelStart = 6
             If X > 5 Then Mid(t, 7, 4) = "____": .Text = t: .SelStart = 0
        Case 96 To 105
            t = .Text
            X = .SelStart
            If .SelLength = 2 Then
                If Mid(t, X + 1, .SelLength) Like "*/*" Then keycode = 0: Exit Sub
                Mid(t, X + 1, 2) = Chr(keycode - 48) & "_": keycode = 0: .Text = t: .SelStart = X + 1: .SelLength = 0
                If Not .Text Like "*_" Then verifdate txt
                Exit Sub
            End If
            If InStr(t, "_") = 0 And .SelLength = 0 Then keycode = 0
            t = .Text
            If InStr(1, t, "_") <> 0 Then Mid(t, InStr(1, t, "_")) = Chr(keycode - 48): keycode = 0
            If Val(Mid(t, 1, 1)) > 3 Then Mid(t, 1, 1) = "_"
            If Val(Mid(t, 1, 2)) > 31 Then Mid(t, 1, 2) = "__"
            If Val(Mid(t, 4, 1)) > 1 Then Mid(t, 4, 1) = "_"
            If Val(Mid(t, 4, 2)) > 12 Then Mid(t, 4, 1) = "__": keycode = 0: Exit Sub
            If InStr(1, t, "_") = 4 And Not IsDate(Mid(t, 1, 3) & "01/2000") Then Mid(t, 1, 2) = "__": .SelStart = 0
            If InStr(1, t, "_") = 7 And Not IsDate(Mid(t, 1, 6) & "2000") Then Mid(t, 4, 2) = "__": .SelStart = 3
            If Not t Like "*_*" And Not IsDate(Mid(t, 1, 6) & "2000") Then Mid(t, 4, 2) = "__": .Text = t
            If Not t Like "*_*" And Not IsDate(t) Then Mid(t, 7, 4) = "____"
            .Text = t: .SelStart = InStr(1, t, "_") - IIf(InStr(1, t, "_") = 0, 0, 1):
          If Not .Text Like "*_" Then verifdate txt
  Exit Sub
        Case Else: keycode = 0
        End Select
    End With
End Sub
Private Sub verifdate(txt As Object)
If Not txt.Value Like "*_*" Then
Dtoday = Date
Darrive = txt.Value
ddiff = DateDiff("d", Dtoday, CDate(Darrive))
MsgBox ddiff
End If
End Sub

demo

[unparia]

Bonjour Passepartout007
Méfie-toi des codes "faux-amis". Il peuvent conduire à des situations désastreuses.
Je ne vais pas faire un inventaire complet (serait trop long) des failles, etc ... qui m'ont conduit à pouvoir par exemple saisir (gestes avec des gros doigts) -->>
201/01/4400
2_1_2_1/4400
_1_____00
Eh oui ...
Je vais te parler par ailleurs d'un petit scenario où aucun des gestes n'est l'un des plus habituels et naturels -->>
1) L'utilisateur saisit par erreur 01/01/3018
2) il se rend compte de son erreur et
3) très naturellement, sélectionne 3018 pour y saisir 2018
4) il frappe donc (1ère touche de correction) un 2
Il se retrouve avec 201/01/3018
et
5) se retrouve alors dans une vraie galère qui, cette fois-ci, ne se contentera pas de geste simples.

Allez -->> teste donc ce petit scenario-là

[Passepartout007]

Bonsoir unparia,

Je te remercies pour cette mise en garde et effectivement le scénario est désastreux. Merci de m'avoir signaler cette possibilité de bug et d'avoir usé de ton œil averti.
J'ai effectuer ce même teste sur mon code initial et je n'ai pas ce problème.

A tu une solutions pour généraliser mon code initial ou amélioré celui-ci et donc l'appliquer à toutes mes Textboxs ?

Cordialement,

Passepartout007

[patricktoulon]

re
allez correction passe partout puisque visiblement il faut prevoir aussi la manipulation d'un clavier par des personnes avec des doigts disproportionnés ou atrofies

voila tape ta date une fois qu'elle est complete tape enter

du coup j'ai meme encore plus simplifier le sellength 2/4 ou contient"*/*"

voila teste celle ci tu m'en dira des nouvelles

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
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Private Sub control_saisie(txt As Object, keycode)
    With txt
        t = .Text
        X = .SelStart
        If Mid(t, X + 1, .SelLength) Like "*/*" Then keycode = 0: Exit Sub
        Select Case keycode
        Case 13: verifdate txt: Exit Sub
        Case 8
            .SelStart = X: keycode = 0:
            If X < 6 Then Mid(t, 4, 2) = "__": .Text = t: .SelStart = 2
            If X < 3 Then Mid(t, 1, 2) = "__": .Text = t: .SelStart = 0
            If X > 5 Then Mid(t, 7, 4) = "____": .Text = t: .SelStart = 5
        Case 46
            .SelStart = X: keycode = 0:
            If X < 3 Then Mid(t, 1, 2) = "__": .Text = t: .SelStart = 3
            If X >= 3 And X < 5 Then Mid(t, 4, 2) = "__": .Text = t: .SelStart = 6
            If X > 5 Then Mid(t, 7, 4) = "____": .Text = t: .SelStart = 0
        Case 96 To 105
            t = .Text
            X = .SelStart
            If .SelLength > 1 Then
                Mid(t, X + 1, .SelLength) = Chr(keycode - 48) & Left("___", .SelLength - 1): keycode = 0: .Text = t: .SelStart = X + 1: .SelLength = 0
                Exit Sub
            End If
            If InStr(t, "_") = 0 And .SelLength = 0 Then keycode = 0
            t = .Text
            If InStr(1, t, "_") <> 0 Then Mid(t, InStr(1, t, "_")) = Chr(keycode - 48): keycode = 0
            If Val(Mid(t, 1, 1)) > 3 Then Mid(t, 1, 1) = "_"
            If Val(Mid(t, 1, 2)) > 31 Then Mid(t, 1, 2) = "__"
            If Val(Mid(t, 4, 1)) > 1 Then Mid(t, 4, 1) = "_"
            If Val(Mid(t, 4, 2)) > 12 Then Mid(t, 4, 1) = "__": keycode = 0: Exit Sub
            If InStr(1, t, "_") = 4 And Not IsDate(Mid(t, 1, 3) & "01/2000") Then Mid(t, 1, 2) = "__": .SelStart = 0
            If InStr(1, t, "_") = 7 And Not IsDate(Mid(t, 1, 6) & "2000") Then Mid(t, 4, 2) = "__": .SelStart = 3
            If Not t Like "*_*" And Not IsDate(Mid(t, 1, 6) & "2000") Then Mid(t, 4, 2) = "__": .Text = t
            If Not t Like "*_*" And Not IsDate(t) Then Mid(t, 7, 4) = "____"
            .Text = t: .SelStart = InStr(1, t, "_") - IIf(InStr(1, t, "_") = 0, 0, 1):
            Exit Sub
        Case Else: keycode = 0
        End Select
    End With
End Sub
Private Sub verifdate(txt As Object)
    If Not txt.Value Like "*_*" Then
        Dtoday = Date
        Darrive = txt.Value
        ddiff = DateDiff("d", Dtoday, CDate(Darrive))
        MsgBox ddiff
    End If
End Sub

j'ai meme tenté 36 touches en meme temps j'ai martirisé mon clavier et pas d'erreur

[Jean-Philippe André]

Salut,

je me permets d'insister sur la simplification énorme que tu aurais à passer par des controles simples, mais tu as également cette solution que je trouve très esthétique
https://arkham46.developpez.com/arti...utboxplus/doc/

[patricktoulon]

re
voila un exemplaire dans un fichier au propre
quand tu est dans le textbox a tout momments tape enter tu aura soit pas entierement remplie soit la difference de jours avec aujourd'hui

[unparia]

du coup j'ai meme encore plus simplifier le sellength 2/4 ou contient"*/*"

voila teste celle ci tu m'en dira des nouvelles

Puisque l'on veut des nouvelles, en voilà une (parmi d'autres) --->>
210/11/1111
Et à partir de cette "date" maintenant là --->> la galère pour en sortir !!!!
Comment ai-je fait ? -->> cherche toi-même.
Une indication : moi, je n'ai ni

tenté 36 touches en meme temps

, ni

martirisé mon clavier

Bref ...

[pijaku]

Salut,
C'est l'invasion des Huns!

Patapé je suis déjà dehors...

[unparia]

Salut,
C'est l'invasion des Huns!

Ou tout simplement le même effet que celui de la multiplication des oxalides via leurs nodules (c'est justement la saison).
Amitiés.

[patricktoulon]

re
bonjour unparia
oui autant pour moi

je comprenais pas mais j'ai fini par reessayer ce que je lui ai envoyé et effectivement c'etait l celui d'avant du coup je l'ai ai toute suprimé pour ne garder que le bon
je me suis simplement trompé je lui est pas envoyé la derniere mouture que j'ai faite apres ton comentaire avec les 3 chiffre devant qui chez moi est impossibles
car il est tout bonnement impossible de supprimer le slash en position 3 et 6 par simplement par l'interdiction de le retrouver dans une selection quelconque car la sub te rejette si dans une selection de chaine on a un ou des slashs sauf selection entiere qui autorise la touche suppr et remet tout a "__/__/____"

voila dis moi que tu y arrive encore il faudra m'expliquer comment

je dois avouer une chose contrairement a ce que l'on pourrait, croire, gérer la date et un masque de saisie en meme temps rend la chose plus facile
en effet le masque de saisie et la pour le dezign mais il me sert de matrice en quelque sorte

[Passepartout007]

Bonjour tous le monde,

Alors je me permet de vous remercier pour ce cheminement de critique corrections cela me permet de mieux comprendre ce qui se passe. Pour rappel je débute en code VBA.

Je te remercie patricktoulon pour tes corrections je viens de tester ton fichier et effectivement le bug d'ajouter un lettre devant la date ne semble plus être présent. En faisant ce teste j'ai remarquer un autre petit disfonctionnement.
Je suis dans l'incapacité de le corrigé car je ne suis pas à votre niveau d'expertise en VBA.

Pour effectuer ce bug :

Sélectionner les numéros jours ou mois, écrire un numéro 7 par exemple.

j'obtiens

Voila, cependant le problème semble se régler si l'on continu de saisir la date donc cela n'est pas un soucis majeur car il y à un contrôle de format de date sur le texbox.
Je tenais juste à faire remonter cette information et je tiens encore à vous remercier de votre aide.
Je rester à l'écoute d'autre proposition de code me permettant la même chose.
Cordialement,
Passepartout007

[unparia]

Quoi ? S'il faut ouvrir ta pièce jointe pour tester ton code, tu peux longtemps compter la-dessus et boire de l'eau fraiche !

[Passepartout007]

Bonjour patricktoulon et unparia,

Après quelque temps d'utilisation j'ai malheureusement réussi à réeffectuer le bug sans le vouloir.

Je rentre une date puis je sélectionne le 2eme chiffe du mois:


Je clic ensuite sur un numéro supérieur à 2 :



Et une fois que j'essaye de supprimé le numéro ça me fais ça :



Alors cela m'embête je joints le code ici :

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
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
 
Private Sub TextBox1_KeyDown(ByVal keycode As MSForms.ReturnInteger, ByVal Shift As Integer)
    control_saisie TextBox1, keycode
End Sub
Private Sub TextBox2_KeyDown(ByVal keycode As MSForms.ReturnInteger, ByVal Shift As Integer)
    control_saisie TextBox2, keycode
End Sub
 
Private Sub TextBox3_KeyDown(ByVal keycode As MSForms.ReturnInteger, ByVal Shift As Integer)
    control_saisie TextBox3, keycode
End Sub
Private Sub control_saisie(txt As Object, keycode)
    With txt
        t = .Text
        X = .SelStart
      If .SelLength = 10 And keycode = 46 Then txt = "__/__/____": keycode = 0: Exit Sub
        If Mid(t, X + 1, .SelLength) Like "*/*" Then keycode = 0: Exit Sub
          Select Case keycode
        Case 13: verifdate txt: Exit Sub
        Case 8
            .SelStart = X: keycode = 0:
            If X < 6 Then Mid(t, 4, 2) = "__": .Text = t: .SelStart = 2
            If X < 3 Then Mid(t, 1, 2) = "__": .Text = t: .SelStart = 0
            If X >= 6 Then Mid(t, 7, 4) = "____": .Text = t: .SelStart = 5
        Case 46
            .SelStart = X: keycode = 0:
            If X < 3 Then Mid(t, 1, 2) = "__": .Text = t: .SelStart = 3
            If X >= 3 And X < 6 Then Mid(t, 4, 2) = "__": .Text = t: .SelStart = 6
            If X > 4 Then Mid(t, 7, 4) = "____": .Text = t: .SelStart = 0
 
        Case 96 To 105
            t = .Text
            X = .SelStart
            If .SelLength > 1 Then
                Mid(t, X + 1, .SelLength) = Chr(keycode - 48) & Left("___", .SelLength - 1): keycode = 0: .Text = t: .SelStart = X + 1: .SelLength = 0
                Exit Sub
            End If
            If InStr(t, "_") = 0 And .SelLength = 0 Then keycode = 0
            t = .Text
            If InStr(1, t, "_") <> 0 Then Mid(t, InStr(1, t, "_")) = Chr(keycode - 48): keycode = 0
            If Val(Mid(t, 1, 1)) > 3 Then Mid(t, 1, 1) = "_"
            If Val(Mid(t, 1, 2)) > 31 Then Mid(t, 1, 2) = "__"
            If Val(Mid(t, 4, 1)) > 1 Then Mid(t, 4, 1) = "_"
            If Val(Mid(t, 4, 2)) > 12 Then Mid(t, 4, 1) = "__": keycode = 0: Exit Sub
            If InStr(1, t, "_") = 4 And Not IsDate(Mid(t, 1, 3) & "01/2000") Then Mid(t, 1, 2) = "__": .SelStart = 0
            If InStr(1, t, "_") = 7 And Not IsDate(Mid(t, 1, 6) & "2000") Then Mid(t, 4, 2) = "__": .SelStart = 3
            If Not t Like "*_*" And Not IsDate(Mid(t, 1, 6) & "2000") Then Mid(t, 4, 2) = "__": .Text = t
            If Not t Like "*_*" And Not IsDate(t) Then Mid(t, 7, 4) = "____"
            .Text = t: .SelStart = InStr(1, t, "_") - IIf(InStr(1, t, "_") = 0, 0, 1):
 
            Exit Sub
        Case Else: keycode = 0
        End Select
    End With
 
End Sub
 
Private Sub verifdate(txt As Object)
    If Not txt.Value Like "*_*" Then
        Dtoday = Date
        Darrive = txt.Value
        ddiff = DateDiff("d", Dtoday, CDate(Darrive))
        MsgBox "la diference est de  " & ddiff & " jours"
 
    Else
        MsgBox "la date n'apas été compléteée entierement "
 
 
 
    End If
End Sub

Alors si je peux me permettre de demander à patricktoulon MAIS aussi à unparia de m'apporté une solution d'amélioration.
Unparia tu a l'aire d'être bien avertie des défaillances de code, peux tu proposé un axe d'amélioration ou une autre structure de code permettant d'effectuer ce que je veux faire.
Patricktoulon je te remercie encore de ton aide et je suis désolé te demander plus de travail sur ce code, je suis déjà reconnaissant du travail que tu m'as apporter.

PS: si les différents Msgbox de validation de la date pouvais se faire à la sortie du texbox et non en appuyant sur "Entrée" cela m'arrangerais. (Exemple en saisie la date on clic sur un autre texbox, la date n'est pas bien rentrée, on refais focus le curseur sur la texbox ou il y à l'erreur)

[patricktoulon]

re

voila pour un sellength(1) corrigé

pour le exit il y a quelque chose qui m'echappe il semble ne pas fonctionner (confilt avec focus)

change ta fonction pour celle ci

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
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Private Sub TextBox1_KeyDown(ByVal keycode As MSForms.ReturnInteger, ByVal Shift As Integer)
    control_saisie TextBox1, keycode
End Sub
Private Sub control_saisie(txt As Object, keycode)
'--merci de laisser ces 2 lignes de commentaires si vous utiliser ce mécanisme--
'-- l'auteur de cette fonction est Patrick Verne----:):):):):)Alias patricktoulon--------------------------
    With txt
        t = .Text
        X = .SelStart
        If .SelLength = 10 And keycode = 46 Then txt = "__/__/____": keycode = 0: Exit Sub
        If Mid(t, X + 1, .SelLength) Like "*/*" Then keycode = 0: Exit Sub
        Select Case keycode
        Case 13: verifdate txt: Exit Sub
        Case 8
            .SelStart = X: keycode = 0:
            If X < 6 Then Mid(t, 4, 2) = "__": .Text = t: .SelStart = 2
            If X < 3 Then Mid(t, 1, 2) = "__": .Text = t: .SelStart = 0
            If X >= 6 Then Mid(t, 7, 4) = "____": .Text = t: .SelStart = 5
        Case 46
            .SelStart = X: keycode = 0:
            If X < 3 Then Mid(t, 1, 2) = "__": .Text = t: .SelStart = 3
            If X >= 3 And X < 6 Then Mid(t, 4, 2) = "__": .Text = t: .SelStart = 6
            If X > 4 Then Mid(t, 7, 4) = "____": .Text = t: .SelStart = 0
        Case 96 To 105
            t = .Text
            X = .SelStart
            If .SelLength > 1 Then
                Mid(t, X + 1, .SelLength) = Chr(keycode - 48) & Left("___", .SelLength - 1): keycode = 0: .Text = t: .SelStart = X + 1: .SelLength = 0
                Exit Sub
            End If
            If .SelLength = 1 Then Mid(t, X + 1, .SelLength) = Chr(keycode - 48): keycode = 0: .Text = t: Exit Sub
            If InStr(t, "_") = 0 And .SelLength = 0 Then keycode = 0
            t = .Text
            If InStr(1, t, "_") <> 0 Then Mid(t, InStr(1, t, "_")) = Chr(keycode - 48): keycode = 0
            If Val(Mid(t, 1, 1)) > 3 Then Mid(t, 1, 1) = "_"
            If Val(Mid(t, 1, 2)) > 31 Then Mid(t, 1, 2) = "__"
            If Val(Mid(t, 4, 1)) > 1 Then Mid(t, 4, 1) = "_"
            If Val(Mid(t, 4, 2)) > 12 Then Mid(t, 4, 1) = "__": keycode = 0: Exit Sub
            If InStr(1, t, "_") = 4 And Not IsDate(Mid(t, 1, 3) & "01/2000") Then Mid(t, 1, 2) = "__": .SelStart = 0
            If InStr(1, t, "_") = 7 And Not IsDate(Mid(t, 1, 6) & "2000") Then Mid(t, 4, 2) = "__": .SelStart = 3
            If Not t Like "*_*" And Not IsDate(Mid(t, 1, 6) & "2000") Then Mid(t, 4, 2) = "__": .Text = t
            If Not t Like "*_*" And Not IsDate(t) Then Mid(t, 7, 4) = "____"
            .Text = t: .SelStart = InStr(1, t, "_") - IIf(InStr(1, t, "_") = 0, 0, 1):
            Exit Sub
        Case Else: keycode = 0
        End Select
    End With
End Sub
Private Sub verifdate(txt As Object)
    If Not txt.Value Like "*_*" Then
        Dtoday = Date
        Darrive = txt.Value
        ddiff = DateDiff("d", Dtoday, CDate(Darrive))
        MsgBox "la diference est de  " & ddiff & " jours"
    Else
        MsgBox "la date n'apas été compléteée entierement "
 
    End If
End Sub

[unparia]

Unparia tu a l'aire d'être bien avertie des défaillances de code, peux tu proposé un axe d'amélioration ou une autre structure de code permettant d'effectuer ce que je veux faire.

Non, c'est toute la "chronologie" même du mécanisme, mais aussi sa "philosophie", qui sont à reconsidérer. On ne "tricote" pas sur du bancale.