Discussion :

[ouskel'n'or]

Je 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

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

ucfoutu

[simond1]

Merci pour ce code, c'est exactement ce que je cherchais, marche parfaitement.