Voir le flux RSS

patricktoulon

forcer la saisie de date avec masque dynamique

Noter ce billet
par , 01/11/2018 à 18h15 (220 Affichages)
UN DATEBOX MULTI FORMAT DYNAMIQUE AVEC MASQUE DE SAISIE
EPISODE 1

bonjour a tous
c'est un exercice qui a été compliqué au depart et nombreux ont été les essais qui ont pu sortir de ma tete et bien mal pensés

cahier des charges pour ce projet

  1. imposer et avoir le choix un format de date dans un textbox
  2. avoir un masque de saisie en l'occurence("__/__/____")
  3. restreindre l'utilisation des touches ( pavé numerique (haut du clavier ou pavé a droite du clavier)) ,la touche back , suppr, fleche(droite et gauche)
  4. avertir et annuler la frappe quand une date (completement rédigée ou pas) est éronée
  5. mise en evidence de l'erreur en selectionnant la partie de la date ou partie de date tapée en erreur
  6. utilisation minimum de variable globale voir pas du tout (economie memoire)
  7. pouvoir naviguer entre les parties de la date avec les touche de navigation(TAB et fleches)
  8. revenir en arriere avec la touche back avec remise en place de la partie homologue du mask
  9. transportabilité
  10. que ce ne soit pas une usine a gaz
  11. j'ai mis en place le masque des la premiere touche tapée quelle quel soit ( vous n'avez donc pas a le mettre en mode edition dans VBE)


bref rendre impossible de taper une date eronnée sans en etre averti

et cela avec un seul evenement textbox (dans cet exercice j'ai choisi le keydown)

il y a divers exemple ici et la je vous laisse le soins d'en apprecier leur valeur en fonction du meme cahier des charges


pour que ce code puisse servir a plusieur textboxs sur un meme userform je l'ai fait dans une sub que l'on mettra dans un module standard

rien ne vous empeche cela dit d'en faire une private sub et la mettre dans le module du userform

j'ai aéré le code pour plus d'aisance dans la lisibilité du code

voila donc la sub
Code vba : 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
Option Explicit
'Date:01/10/2018
'auteur:-------------------------patricktoulon sur developpez.com et excel download
'projet:-------------------------datebox multi format avec mask de saisie dynamique au format injecté dans l'appel
'version:------------------------3.2
'format de date accepté:---------"dd/mm/yyyy" : "mm/dd/yyyy" : "yyyy/mm/dd"
'touche clavier utilisable:------TAB :ENTER :FLECHES (DROITE et GAUCHE) : pavé numerique (HAUT et BAS)
'action 1:-----------------------positionnement automatique pendant la saisie
'action 2:-----------------------navigation dans les parties de la date(jour/mois/année)avec les touches  TAB et fleches(droite et gauche)
'action 3:-----------------------retour et selection automatique en cas d'erreur dans la partie qui viend d'etre tapée
'modifications:le 07/10/2018-----ajout du Rollover sur les touches de navigation(ergonomie)
'modifications le 08/10/2018-----amélioration de la gestion des touches de navigation et de la touche back(ergonomie)(le next segment pris en compte au selstart+1)
'modifications le 08/10/2018-----ajout du test si le format injecté n'est pas accepté et de la sortie avec message
'modifications le 12/10/2018-----correction l'erreur non relevée du "00" mois et jour
 
Sub control_saisiex(txt, KeyCode, Optional Forme As String = "dd/mm/yyyy")
    Dim t$, xL&, X&, M&, J&, A&, Ji&, Mi&, Ai&, finD&, ldate As Date, MasK$
    'calcul des  selstart autorisés pour le keycode 96 to 105 en fonction du format
    Ji = InStr(1, Forme, "d"): Mi = InStr(1, Forme, "m"): Ai = InStr(1, Forme, "y")
    'Création du  mask en fonction du format injecté dans l'apel
    If Ai = 7 Then finD = 6 Else finD = 8    'repere pour le next selstart avec les touches de navigation
    Select Case Forme
    Case "yyyy/mm/dd": MasK = "____/__/__": Case "dd/mm/yyyy", "mm/dd/yyyy": MasK = "__/__/____"
    Case Else: MsgBox "le format demandé n'est pas accepté": KeyCode = 0: Exit Sub    'si un format injecté nest pas valide on sort
    End Select
    With txt
        If .Value = "" Then .Value = MasK                                       'au cas ou le masque n'y serait pas au depart
        t = .Value                                                              'T prend la valeur du textbox
        If TypeName(.Parent) = "UserForm" Then .ControlTipText = Forme          ' bulle indiquant le format qui a été injecté
        If t = MasK Then .SelStart = 0                                          ' on se positionne a gauche si pas de date(mask vierge)
        X = .SelStart: xL = .SelLength                                          'on determine la position et le length de la selection
        If KeyCode >= 48 And KeyCode <= 57 Then KeyCode = KeyCode + 48          ' pour ce qui n'ont pas le pavé numerique et se servent des chiffre en haut de clavier
        Select Case KeyCode
            '_____________________________________________________________________________________________________
            'Gestion  des touches du  pavé numerique(haut et bas)
        Case 96 To 105
            Select Case X
            Case Ji - 1 To Ji, Mi - 1 To Mi, Ai - 1 To Ai + 2
                Mid$(t, X + 1, IIf(xL = 0, 1, xL)) = Chr(KeyCode - 48) & Mid$(MasK, X + 2): .Value = t: .SelStart = X + 1
            Case Else: KeyCode = 0
            End Select
            If Mid$(t, X + 2, 1) = "/" Then .SelStart = X + 2
            KeyCode = 0
            '_______________________________________________________________________________________
            'controle de la validité de la date ici
            J = Val(Mid$(t, Ji, 2)): M = Val(Mid$(t, Mi, 2)): A = IIf(Mid$(t, Ai, 4) Like "*_*", 2000, Val(Mid$(t, Ai, 4)))    'récuperation du jour  mois année en fonction de l'etat de la saisie
            J = IIf(J = 0, 1, J): M = IIf(M = 0, 1, M): ldate = DateSerial(A, M, J):  'date théorique ou reele dynamique
            If Day(ldate) <> J Or Month(ldate) <> M Or Year(ldate) <> A Or Val(Mid$(t, Ji, 1)) > 3 Or Val(Mid$(t, Mi, 1)) > 1 Or Mid$(t, Ji, 2) = "00" Or Mid$(t, Mi, 2) = "00" Then  'Condition d 'erreur globale
                X = InStrRev(Mid$(t, 1, X), "/"): xL = IIf(X = Ai - 1, 4, 2): Mid(t, X + 1, xL) = Mid(MasK, X + 1, xL): .Value = t: .SelStart = X: .SelLength = xL: Beep    'repositionnement et annulation de la partie en erreur
            End If
            '_____________________________________________________________________________________________________
            'Gestion de la Touche back(retours en arrière)
        Case 8
            If InStr(Mid$(t, 1, X), "/") > 0 Then X = InStrRev(Mid$(t, 1, InStrRev(Mid$(t, 1, X), "/") - IIf(Mid(t, X, 1) = "/", 1, 0)), "/") Else X = 0
            KeyCode = 0: xL = IIf(X = Ai - 1, 4, 2): Mid$(t, X + 1, xL) = "____": .Value = t: .SelStart = IIf(t = MasK, 0, X): .SelLength = IIf(t = MasK, 0, xL)
            '_____________________________________________________________________________________________________
            'Gestion de la Touche suppr(supprimer)remplace la partie selectionnée   par son homologue du  masque
        Case 46
            xL = IIf(xL = 0, 1, xL): KeyCode = 0: Mid$(t, X + 1, xL) = Mid$(MasK, X + 1, xL): .Value = t: .SelStart = IIf(t = MasK, 0, X)
 
            '_____________________________________________________________________________________________________
            'gestion de la Touche fleche gauche  deplacement vers la gauche et Rollover
        Case 37
             KeyCode = 0: X = InStrRev(t, "/", IIf(X = 1, 2, X - 1)): xL = IIf(X = Ai - 1, 4, 2):
            .SelStart = IIf(t = MasK, 0, X): .SelLength = IIf(t = MasK, 0, xL)
 
            '_____________________________________________________________________________________________________
            'Gestion de la Touche fleche droite et la touche tab deplacement vers la droite et Rollover
        Case 39, 9
            If InStr(Mid$(t, X + 1), "/") > 0 Then X = X + InStr(1, Mid$(t, X + 1), "/") Else X = 0    'x=find si on veut pas que ca tourne
            KeyCode = 0: .SelStart = IIf(t = MasK, 0, X): .SelLength = IIf(t = MasK, 0, IIf(X = Ai - 1, 4, 2))
        Case 13
            If InStr(txt.Value, "_") Then KeyCode = 0
            '_____________________________________________________________________________________________________
            'Gestion des  autres touches
        Case Else: KeyCode = 0
        End Select
    End With
End Sub

et donc dans le userform OUpour un textbox dans un sheets on l'appelera comme suit avec l'evenement keydown
exemple :
Code vba : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
Option Explicit
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
control_saisiex TextBox1, KeyCode, "yyyy/mm/dd"
End Sub
Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
control_saisiex TextBox2, KeyCode, "dd/mm/yyyy"
End Sub
Private Sub TextBox3_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
control_saisiex TextBox3, KeyCode, "yyyy/mm/dd"
End Sub
Private Sub TextBox4_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
control_saisiex TextBox4, KeyCode 'sans argument le format par defaut est francais
End Sub

pour le cas ou avec la souris on clique sur un autre control et donc sortie du textbox en ayant pas une date correcte
on bloque la sortie avec le before update
mais ca reste a la charge du developpeur: en effet les possibilité en fonction de la sortie peuvent etre diverses et variée
le travaille ici a consisté uniquement a controler la saisie

mais bien que l'on sorte de mon projet qui est l'utilisation du keydown , il est interessant et utile de le proposer
un exemple selon pijaku :
Code vba : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) 
   Cancel = Not IsDate(TextBox1.Value)
End Sub

et pour proteger le textbox contre la modification par vba

Code vba : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
Private Sub TextBox1_Change()
   If TextBox1 <> ActiveControl Then
      If Not IsDate(TextBox1.Value) Then TextBox1.Value = "__/__/____"
   End If
End Sub


Merci pijaku pour les tests

un classeur en exemple en piece jointe
Miniatures attachées Fichiers attachés

Envoyer le billet « forcer la saisie de date avec masque dynamique » dans le blog Viadeo Envoyer le billet « forcer la saisie de date avec masque dynamique » dans le blog Twitter Envoyer le billet « forcer la saisie de date avec masque dynamique » dans le blog Google Envoyer le billet « forcer la saisie de date avec masque dynamique » dans le blog Facebook Envoyer le billet « forcer la saisie de date avec masque dynamique » dans le blog Digg Envoyer le billet « forcer la saisie de date avec masque dynamique » dans le blog Delicious Envoyer le billet « forcer la saisie de date avec masque dynamique » dans le blog MySpace Envoyer le billet « forcer la saisie de date avec masque dynamique » dans le blog Yahoo

Mis à jour 12/11/2018 à 20h20 par patricktoulon

Tags: date, datebox, vba
Catégories
Sans catégorie

Commentaires

  1. Avatar de patricktoulon
    • |
    • permalink
    prochain episode en couleur
  2. Avatar de iliesss
    • |
    • permalink
    Mille merci Mr patrick c'est le perfectionnement du travail
  3. Avatar de patricktoulon
    • |
    • permalink
    Citation Envoyé par iliesss
    Mille merci Mr patrick c'est le perfectionnement du travail
    de rien iliess chose promises choses dues
  4. Avatar de patricktoulon
    • |
    • permalink
    merci Arkham pour l'erreur non relevée du"00" pour jour ou mois
    c'est corrigé
  5. Avatar de iliesss
    • |
    • permalink
    Merci Mr Patrick pour cette correction
  6. Avatar de patricktoulon
    • |
    • permalink
    Citation Envoyé par iliesss
    Merci Mr Patrick pour cette correction
    de rien iliess je l'avais pas vu
    la version tout format de date en couleur et prete ,je teste encore toute les petites chose comme ce "00"
    il me reste une petite question un petit doute et j'editerais