Envoyé par ucfoutuJe me suis un peu cassé la tête pour faire avec VBA (dont je me sers tous les 36 du mois) presque tout de ce que je peux faire beaucoup mieux avec VB.
Cet outil permet de paramétrer comme on l'entend les dates à saisir, tant en ce qui concerne la forme (aaaa/mm/jj, mm/jj/aaaa ou jj/mm/aaaa) que le séparateur lui même (/, - ou espace)
Le tout est un module qui pèse moins de 3 Ko ...
Le contrôle de la saisie se fait en cours de saisie (incohérence immédiatement signalée par un bip et refus de la frappe du caractère concerné)
Le tout en permettant des copiers/collers de dates cohérentes et répondant au format défini
mettre ce qui suit dans un userform, avec 3 textboxes
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 'NOTE : verifcomplet permet de ne pas quitter une saisie incomplète, 'sauf si elle est encore vide 'Notez bien également : si vous préférez utiliser yyyy à la place de aaaa ' et dd à la place de jj, c'est prévu (vous vouvez donc le faire) '=================================================================== 'ici, on traite les saisie de dates françaises Private Sub TextBox1_Change() Static javais As String javais = ctrldate(ActiveControl, "jj/mm/aaaa", javais) End Sub Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) Cancel = Not verifcomplet(TextBox1) End Sub '=================================================================== 'ici, on traite les saisies de dates anglaises Private Sub TextBox2_Change() Static javais As String javais = ctrldate(ActiveControl, "mm/jj/aaaa", javais) End Sub Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean) Cancel = Not verifcomplet(TextBox2) End Sub '=================================================================== 'ici, on traite les saisies de dates américaines "année d'abord" Private Sub TextBox3_Change() Static javais As String javais = ctrldate(ActiveControl, "aaaa/mm/jj", javais) End Sub Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean) Cancel = Not verifcomplet(TextBox3) End Sub
mettre ceci (le module de traitement) dans un module standard
ucfoutu
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 Option Explicit Private Function j0(q As Control, jfr As String, ch As String) As String j0 = ch Dim t As String t = q.Text q.SelStart = Len(t) If q.SelStart < Len(t) Then q.SelStart = Len(t) Beep Exit Function End If Dim jrf1 As String, jrf2 As String, jflt As String, j1 As String, jms As String Select Case Left(jfr, 1) Case "d", "m", "j" j1 = Mid(jfr, 3, 1) jflt = "##" & j1 & "##" & j1 & "####" If Left(jfr, 1) = "m" Then jrf2 = "01" & j1 & "01" & j1 & "2000" jrf1 = "01" & j1 & "10" & j1 & "2000" jms = Left(t, 2) Else jrf1 = "01" & j1 & "10" & j1 & "2000" jrf2 = "01" & j1 & "03" & j1 & "2000" jms = Mid(t, 4, 2) End If Case "a", "y" j1 = Mid(jfr, 5, 1) jflt = "####" & j1 & "##" & j1 & "##" jrf2 = "2000" & j1 & "01" & j1 & "01" jrf1 = "2000" & j1 & "01" & j1 & "10" jms = Mid(t, 6, 2) End Select If Not t Like Left(jflt, Len(t)) Then Beep: Exit Function Dim jrf As String If Val(jms) > 12 Or Val(Left(jms, 1)) > 1 Then Beep: Exit Function If jms > "0" Then jrf = t & Mid(jrf1, Len(t) + 1) Else jrf = t & Mid(jrf2, Len(t) + 1) End If If Not IsDate(jrf) Then Beep: Exit Function j0 = q.Text If Len(j0) < Len(ch) And Right(ch, 1) = j1 Then j0 = Left(ch, Len(ch) - 2) '============ Exit Function End If If Len(j0) < Len(ch) And Right(ch, 2) Like j1 & "#" Then j0 = Left(ch, Len(ch) - 1) Exit Function End If Dim lj0 As Integer lj0 = Len(j0) If Left(jfr, 1) <> "y" And Left(jfr, 1) <> "a" Then If (lj0 = 2 Or lj0 = 5) And Len(t) > Len(ch) Then j0 = j0 & j1 Else If (lj0 = 4 Or lj0 = 7) And Len(t) > Len(ch) Then j0 = j0 & j1 End If End Function Public Function ctrldate(q As Control, leformatdate As String, ch As String) As String ctrldate = j0(q, leformatdate, ch) q.Text = ctrldate End Function Public Function verifcomplet(q As Control) verifcomplet = True If Len(q.Text) Mod 10 <> 0 Then MsgBox "saisie incomplète !" verifcomplet = False End If End Function
Partager