Masque de saisie date dans textbox

Version imprimable

Voir 40 message(s) de cette discussion en une page

27/10/2018, 22h43
iliesss

2 pièce(s) jointe(s)

Masque de saisie date dans textbox

Bonsoir
J'ai lu cette discussion.
merci pour tous les gents qui développent ce joli travail et qui participent avec leurs idées
J'ai suivi toutes les étapes et ça marche très bien sauf que le curseur se trouve a la fin de mon TextBox1
Svp comment je le position au début de mon TextBox1
Pièce jointe 422615

et voici mon fichier Démo
28/10/2018, 10h58
patricktoulon

2 pièce(s) jointe(s)

re
bonjour
je te propose une autre solution
elle est vallable pour les format jour/mois/année OU mois jour année (dd/mm/yyyy)ou (mm/dd/yyyy)
1. elle donne la possibilité de revenir en arriere avec la touche back (le masque se remet en place )
2. d'utiliser la touche suppr pour effacer un segment (le masque se remet en place )
3. le carret(ou curseur) suit la progression
4. c'est vallable pour les textbox dans userform ou textbox sur sheets
5. si tu tape une donnée non valide elle s'annule exemple 31/02 le 02 s'efface
6. si tu demarre avec 33 ca s'annule aussi
7. si la date entiere n'est pas valide a la fin l'année s'annule
c'est une simple sub :c'est d'ailleur la meme dans le module du sheet(1) et le module du userform
Pièce jointe 422685
fichier en demo
28/10/2018, 20h36
iliesss

Merci beaucoup Mr Patricktoulon c'est un très propre et joli travail
:bravo::bravo::bravo::bravo::bravo::bravo::bravo::bravo:
29/10/2018, 17h19
iliesss

Svp Mr Patricktoulon
après la saisie de la date dans TextBox1 et lorsque je clic sur entrée pour déplacer vert TextBox2 le curseur ne se déplace pas

re
je ne crois pas me souvenir de l'avoir prevu il faut l'ajouter
dans le select case keycode tu l'ajoute juste avant le case else

cet exemple est valable dans mon model
je t'empeche de sortir si il reste un tiret dans le textbox
Code:

1 2 3 4 5 6 7 8 Case 13 X = txt.TabIndex If txt.Value Like "*_*" Then KeyCode = 0 Else With txt.Parent.Controls(X + 1): .SetFocus: .SelStart = 0: End With End If
a ameliorer bien sur j'ai pas prevu tout les cas de figure

29/10/2018, 22h14
iliesss

Bonjour
Bravo Mr patricktoulon
Ça marche très bien
:applo::applo::applo:

Bonjour iliess
ne t'emballe pas j'ai trouvé encore des bugs en ce qui concerne les retours et la manipulation des touches back et suppr
j'ai entierement revu le code

1° plus besoins d'avoir le masque a la base si il n'y est pas ca le met automatiquement
2° on ne peux plus selectionner une portion avec un "/" et appuyer sur la touche "back"( il ne doit pas y avoir selection pour la touche back )donc l'action s'annule
3° la touche suppr offre les 4 possibilités
°si pas de selection supprime le chiffre devant le curseur
°si selection contenant un "/" il n'est pas supprimé seule les chiffre sont remplacé par le masque
°si selection d'un segment (jour ou mois ou année) remplacement uniquement de la selection
°si selection complete retour du masque vierge complet
4° j'ai simplifié le control de date valide et saisie par segment et nom chiffre par chiffre
° si tu tape plus grand que 31 au depart ca s'annule
° si les deux segment us ou fr ne corespondent pas a une date valide le segment2 s'annule
° si la date complete n'est pas valide (exemple 29/02/2001) l'année s'annule
5° j'ai ajouté des msgboxs te donnant l'indication sur l'erreur de saisie

maintenant cette sub peut etre dans un module standard ou celui du textbox (j'ai opté pour le module stadard)

code dans le module standard

Code:

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
Option Explicit
Sub control_saisie(txt As Object, KeyCode)
    Dim T As String, MsA$, MsJ$, msM$, X&, I&
    MsA = "l'année n'est pas valide pour cette date"
    MsJ = " le premier segment (jour/mois) n'est pas valide"
    msM = " le 2d segment(jours/mois) n'est pas valide"
    With txt
        If txt = "" Then txt = "__/__/____"
        T = .Value
        If T Like "__/__/____" Then .SelStart = 0
        X = .SelStart
        Select Case KeyCode
        Case 8
            If Mid(T, X + 1, .SelLength) Like "*/*" Or .SelLength > 0 Then KeyCode = 0: Exit Sub
            If X > 0 And .SelLength = 0 Then
                Mid(T, X) = IIf(X = 3 Or X = 6, "/", "_"): .Value = T: KeyCode = 0: .SelStart = X - 1
            End If
        Case 46
            KeyCode = 0
            If .SelLength > 0 Then For I = X To X + .SelLength - 1: Mid(T, I + 1, 1) = IIf(Mid(T, I + 1, 1) <> "/", "_", "/"): Next: .Text = T: .SelStart = X: KeyCode = 0: Exit Sub
        If X < 10 And Mid(T, X + 1, 1) <> "/" Then Mid(T, X + 1, 1) = "_": .Text = T: .SelStart = X + 1 Else .SelStart = X + 1
        If .SelLength = 0 Then Mid(T, X + 1, 1) = IIf(Mid(T, X + 1, 1) <> "/", "_", "/"): .SelStart = X
    Case Is >= 95 And KeyCode <= 105
        If Mid(T, X + 1, 1) = "/" Then KeyCode = 0: Exit Sub
        If .SelLength = 0 Then
            If Not T Like "*_*" And IsDate(T) Then KeyCode = 0: Exit Sub
            Mid(T, X + 1, 1) = Chr(KeyCode - 48): KeyCode = 0: .Value = T:
            .SelStart = IIf(Mid(T, X + 2, 1) = "/", X + 2, X + 1)
 
        ElseIf .SelLength > 1 Then
            If Mid(T, X + 1, .SelLength) Like "*/*" Then KeyCode = 0: .SelLength = 0: Exit Sub
            Mid(T, X + 1, .SelLength) = Chr(KeyCode - 48) & Left("____", .SelLength - 1): .Value = T: KeyCode = 0: .SelStart = X + 1: .SelLength = 1
            If Mid(T, X + 1, 1) <> "_" Then .SelStart = X + 1
        End If
        'controle de date valide
        If Val(T) > 31 Then MsgBox MsJ: .Value = "__/__/____": .SelStart = 0
        If Not (Mid(T, 1, 5)) Like "*_*" And Not IsDate(Mid(T, 1, 5) & "/2000") Then MsgBox msM: Mid(T, X, 2) = "__": .Value = T: .SelStart = X - 1
        If Not T Like "*_*" Then
            If Not IsDate(T) Then Mid(T, 7, 4) = "____": .Value = T: .SelStart = 6: MsgBox MsA: Exit Sub
            If Year(T) <> Val(Mid(T, 7, 4)) Then Mid(T, 7, 4) = "____": .Value = T: .SelStart = 6
        End If
    Case 13
        X = txt.TabIndex
        If txt.Value Like "*_*" Then With txt.Parent.Controls(X + 1): .SetFocus: .SelStart = 0: End With
 
End Select
End With
End Sub

appel a partir d'un textbox dans un sheets

Code:

1
2
3
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
control_saisie TextBox1.Object, KeyCode
End Sub

appel d'un textbox dans un userform

Code:

1
2
3
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
   control_saisie TextBox1, KeyCode
End Sub

si tu rencontre encore des bugs fait le moi savoir

30/10/2018, 13h39
Pierre Fauconnier

1 pièce(s) jointe(s)

Salut.

Vouloir contrôler la saisie dans un textbox est une gageure, la plupart du temps. La meilleure solution reste selon moi de tester après coup que la saisie correspond au pattern et à une date valide. Les élucubrations de code pour contrôler en cours de saisie seront inévitablement battues en brèche lors des tests.

On l'a dit des dizaines de fois sur ce forum, mais certains s'amusent à proposer des solutions foireuses. Cela en devient désespérant.

Je suppose que la solution a été "testée" en saisissant une date...

Pièce jointe 423263

Juste lamentable!
30/10/2018, 14h53
patricktoulon

re

re
pour les lettres j'ai juste oublié de remettre le
case else:keycode=0
30/10/2018, 15h03
iliesss

Bonjour Mr patricktoulon
Je suis en déplacement et après mon retour je vais essayé votre code
Merci
30/10/2018, 15h08
Pierre Fauconnier

Citation:

Envoyé par patricktoulon

re
pour les lettres j'ai juste oublié de remettre le
case else:keycode=0

Ce serait bien que les solutions proposées le soient sans les "j'ai juste oublié"... Histoire que l'on puisse tester et casser le patch suivant ^^
30/10/2018, 15h19
Pierre Fauconnier

5 pièce(s) jointe(s)

juste histoire de montrer que ce n'est pas juste une histoire de lettres

Pièce jointe 423288

Pièce jointe 423296

Pièce jointe 423300

Pièce jointe 423304

Pièce jointe 423305

On va continuer longtemps à perdre son temps avec ce genre de c***?
30/10/2018, 15h47
pijaku

2 pièce(s) jointe(s)

Bonjour,

Pierre,
Tu abuses, tu n'as pas corrigé le case else:keycode=0
;)

Mais, même avec :

Erreur fatale : :oops:

Pièce jointe 423308

Saisie pour le moins fantaisiste (comme la sortie du textbox a été possible, il est validé) : :ptdr:

Pièce jointe 423315
30/10/2018, 15h52
Pierre Fauconnier

1 pièce(s) jointe(s)

hélas, on pourrait continuer comme cela longtemps. La saisie suivante a été validée... :calim2::calim2::calim2:

Pièce jointe 423319

C'est vraiment du n'importe quoi!

PS:

Citation:

Envoyé par pijaku

Bonjour,

Pierre,
Tu abuses, tu n'as pas corrigé le case else:keycode=0[...]

Ce n'est pas au demandeur à corriger le code des "solutions" proposées, me semble-t-il...
30/10/2018, 15h59
pijaku

1 pièce(s) jointe(s)
Citation:

Envoyé par Pierre Fauconnier

hélas, on pourrait continuer comme cela longtemps.

Yep!

Citation:

La saisie suivante a été validée...

Celle-ci également (je l'ai appelé "saisie date futuriste") :
Pièce jointe 423326

EDIT :
Sans parler du :

Code:

Case Is >= 95 And KeyCode <= 105
- KeyCode 95 : SLEEP/STANDBY KEY ON KEYBOARD
30/10/2018, 17h26
patricktoulon

re

re
vous tracassez pas la tete j'ai trouvé en changeant de strategie et le code en est moins lourd
plus aucun autre caracteres autre que 0 a 9 et "/" n'est possible
impossible de deloger les "/" de leur place
30/10/2018, 20h40
pijaku

Patrick,

Peux-tu nous communiquer ce code?
07/11/2018, 21h35
iliesss

bonjour Mr patrick
désolé pour ce retard j’étais en déplacement
j'ai essaye votre dernier code et ça marche très même avec une date de 31/02/2018 ou 29/02/2018 il indique l’erreur de saisie.
Merci
07/11/2018, 21h46
patricktoulon

re

re
bonsoir iliesss
ne te presse pas demain je sort une version sans faille celle que tu a en a encore plein meme
j'ai donc changé de strategie
un code plus leger plus propre

tu en a un apercu dans mon blog mais elle n'est pas encore totalement universelle elle ne fait que 2 format

et issue de cette version j'en ai developpé une qui accepte et supporte les 3 formats les plus répendus , j'attend encore jusqu'a demain voir si j'ai des retours negatifs au cas ou quelque chose m'aurait echapé

je met a jour mon blog demain

patience tu sera pas decu

;)
07/11/2018, 21h49
iliesss

Bon courage mr Patrick je sais que c'est un joli travail
J'attends votre code avec patience

Voir 40 message(s) de cette discussion en une page