XL 2019 Problème d'affichage des dates avec le code ci dessous

[Danielson]

Ce code que j'ai récupérer ici fonctionne bien, mais les mois et les jours peuvent excéder les valeurs permises soit plus de 12 mois ou plus de 31 jours sans compter les erreurs sur les mois de 30 jours et moins. Comment pourrais-je résoudre ce problème et quelle méthode utilisé avec le code ci dessus.

Merci à l'avance

Daniel



CODE=rich]Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

Dim VT As Integer
TextBox1.MaxLength = 10
Select Case KeyAscii
Case 46, 48 To 57

VT = Len(TextBox1)
If VT = 2 Or VT = 5 Then TextBox1 = TextBox1 & "/"
Case Else
KeyAscii = 0
MsgBox "CARACTERE NON AUTORISE"
End Select
End Sub[/CODE]

cordialement galougalou
ps je poste en meme temps que sylvanu( je post ou je post pas............ allez........je post! et je rajoute bonjour sylvanu
[/QUOTE]

Ce code fonctionne bien, mais les mois et les jours peuvent excéder les valeurs permises soit plus de 12 mois ou plus de 31 jours sans compter les erreurs sur les mois de 30 jours et moins. Comment pourrais-je résoudre ce problème et quelle méthode utilisé avec le code ci dessus.

Merci

 

[GALOUGALOU]

bonsoir danielson
essayer cette solution qui avait été proposé par un contributeur sur xld, il est impossible de saisir une date non valide
sélectionner une case et la validation va renseigner la cellule active avec la date choisie.
cordialement
galougalou

 

[Danielson]

bonsoir danielson
essayer cette solution qui avait été proposé par un contributeur sur xld, il est impossible de saisir une date non valide
sélectionner une case et la validation va renseigner la cellule active avec la date choisie.
cordialement
galougalou

Bonsoir GalouGalou,

Je ne peux ouvrir ton fichier car les macros sont désactivées, pourrais-tu me fournir seulement le code d'une textbox date, pour que je modifie mon fichier en conséquence.

Merci

 

[GALOUGALOU]

bonjour
les macros sont désactivés dans votre ordinateur, il suffit de les autoriser en faisant le choix dans sécurité des macros " désactiver avec notifications". et les autoriser pour ce fichier.
voici le code

Dim DateMin As Date, DateMax As Date
' --------------- Initialisation
Sub Userform_Initialize()
DateMin = CDate("01/01/1950")
DateMax = CDate("31/12/2049")
EtiquInfo.Caption = "Saisissez une date entre le " & DateMin & " et le " & DateMax
End Sub



' --------------- N'autorise que la saisie de chiffres
Private Sub TextBox1_KeyPress(ByVal Touche As MSForms.ReturnInteger)
    If InStr("0123456789", Chr(Touche)) = 0 Then Touche = 0: MsgBox "Caractère non autorisé"
End Sub


' ---------------
Private Sub TextBox1_Change()
Dim Validite As Boolean

Call ValidationDate(UserForm1.TextBox1, DateMin, DateMax, Validite)
If Validite = True Then BoutonValider.SetFocus

End Sub
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) 'comme after update
Dim Msg, Style
Dim Validite As Boolean

    If Not IsDate(TextBox1) Then
        Cancel = True
        Call ValidationDate(UserForm1.TextBox1, DateMin, DateMax, Validite)
   Msg = "Pour continuer, vous devez saisir une date comprise 01 01 1910 et 31 12 2050"
        Style = vbOKCancel
        If MsgBox(Msg, Style) = vbCancel Then Cancel = False
        TextBox1 = ""
    End If

End Sub



Private Sub BoutonValider_Click()
' ----- Si besoin date validée en format année à 4 chiffres (sinon on récupère seulement TextBox1.value)

If IsDate(TextBox1.Value) = False Then
MsgBox "Date non valide"
TextBox1 = ""
Exit Sub
End If
If TextBox1.Value <> "" Then MsgBox "Date validée ok : " & FormatDateTime(CDate(TextBox1.Value), vbShortDate): ActiveCell = TextBox1
Unload Me
End Sub

cordialement
galougalou

 

[Danielson]

Bonsoir et Merci pour avoir pris le temps d'écrire ce code, j'ai un message que mes variables ne sont pas définies. Je l'ai ai mises sous private sub initialize de l'userform et j'ai même essayer au dessus de celui-ci mais sans succès.

Bonne soirée et merci beaucoup

 

[patricktoulon]

bonjour
perso je te propose la TOTAL

1. assistance à la saisie
2. en bonus mask de saisie
3. contrôle de validité en cours de saisie
4. beep et couleur en cas de non validité
5. et tout cela pour les deux formats de date (FR:dd/mm/yyyy ou US:mm/dd/yyyy)(region 1 pour FR et 0 pour US

le tout dans une petite fonction condensée utilisable par X textbox dans le même userform

exemple j'ai un textbox1
je vais donc appeler cette fonction non pas dans le keypress mais dans le keydown
et oui je gère aussi les touches back et suppr


exemple d'event

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    control_saisieX TextBox1, KeyCode, region:=1
End Sub

et voila la fonction

Sub control_saisieX(txt As Object, KeyCode, Optional Mask As String = "__/__/____", Optional region As Long = 1)
'MsgBox KeyCode
    Dim Pos&, T$, X&, XL&, xp&, an, XLL&, Max1&, Max2, separateur, charMask$
    separateur = Mid(Mask, 3, 1):    charMask = Left(Mask, 1)
    Max1 = IIf(region = 1, 31, 12): Max2 = IIf(region = 0, 31, 12)
    If KeyCode >= 48 And KeyCode <= 57 Then KeyCode = KeyCode + 48 'conversion du keycode du pavé haut du clavier
    With txt
        If .Value = "" Then .Value = Mask
        T = .Value: .SelStart = IIf(T = Mask, 0, .SelStart): X = .SelStart
        XL = .SelLength
          Select Case KeyCode
        Case 96 To 105  'pavé numerique
            Select Case X
            Case 0 To 1, 3 To 4, 6 To 9    'en fonction du selstart
                XL = IIf(XL = 0, 1, XL)
                Mid$(T, X + 1, XL) = Chr(KeyCode - 48) & Mid$(Mask, X + 2, XL): X = X + 1    'placement du caractere

                'controle date condensé
                If Val(T) > Max1 Or Mid(T, 1, 2) = "00" Then Mid$(T, 1, 2) = Mid$(Mask, 1, 2): X = 0: XLL = 2: Beep     'max 31 pour jour
                If Val(Mid(T, 4, 2)) > Max2 Or Mid(T, 4, 2) = "00" Then Mid$(T, 4, 2) = Mid$(Mask, 4, 2): X = 3: XLL = 2: Beep     ' max 12 pour le mois
                If X > 5 Then xp = 7 Else If X < 4 Then xp = 1 Else xp = 4    'calcul position pour replace by mask
                If IsNumeric(Mid(T, 7, 4)) And X > 5 Then an = Mid(T, 7, 4): XL = 5 Else an = "2000": XL = 2    'année permuté
                If IsDate(Mid(T, 1, 5)) Then If Not IsDate(Mid(T, 1, 5) & separateur & an) Then Mid(T, xp, XL) = Mid(Mask, xp, XL): Beep: X = InStr(1, T, charMask) - 1: XLL = XL
                If Mid(T, 7, 4) = "0000" Then Mid$(T, 7, 4) = Mid$(Mask, 7, 4): X = 6: XLL = 4: Beep

                .Value = T: .SelStart = IIf(Mid(Mask, X + 1, 1) = separateur, X + 1, X): If XLL > 0 Then .SelLength = XLL    'mise a jour textbox et positionement carret
            Case Else: .SelStart = X + 1: KeyCode = 0
            End Select

        Case 8: If X > 0 Then Mid(T, X, 1) = Mid(Mask, X, 1): .Value = T: .SelStart = X - 1    'touche back
        Case 46: Mid(T, X + 1, .SelLength) = Mid(Mask, X + 1, .SelLength): .Value = T: .SelStart = X   'touche "suppr"
        Case 37: .SelStart = Application.Max(.SelStart - 1, 0)    'fleche gauche
        Case 39: .SelStart = Application.Min(.SelStart + 1, Len(T))    'fleche droite

        Case Else: KeyCode = 0    'aucune autre touche autorisée
        End Select
        .Value = IIf(T = Mask, "", T)
           .BackColor = Array(RGB(255, 150, 150), vbWhite)(Abs(XLL < 1)) 'si erreur backcolor
End With
    KeyCode = 0:
End Sub

démonstration
Quand il devient rouge c'est que j'ai tapé une erreur!!! et ca efface directement et te positionne

seule les touches 0 à 9 sont utile le datebox fait le reste tout seul

et si tu veux bloquer la suite si date non finie de tapé
ben tu bloque le exit

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Cancel = InStr(TextBox1.Value, "_") > 0
End Sub

soit tu vide le textbox soit c'est une date entière et valide
enjoy

 

[Danielson]

Merci Patrick,

Malheureusement j'ai fait le test dans userform keycode et au lancement ça semblé fonctionner, mais en effaçant des caractères et revenant a l'arrière ça bogue et j'ai des messages d'erreurs. Le Vb est surement un peu différent du VBA pour certaines fonctions ou méthodes. Je suis du Canada et j'utlise le format aaaa/mm/jj comment faire ?

Voici la ligne qui bogue du moins la première

Max1 = IIf(region = 1, 31, 12): Max2 = IIf(region = 0, 31, 12)




Merci

 

[patricktoulon]

tiens je te donne la next version c'est kado
ca prend tout les format
pour ton format c'est ça

'********************************************************************
'           TEXTBOX FORMATE AVEC MASQUE DE SAISIE DYNAMIQUE
'Auteur patricktoulon sur exceldownload
'Version 2019/2020
'utilisation de l'interception du keycode dans le keydown
'les 3 formats de date géré par excel * le nombre de separateurs possible
'*********************************************************************
Option Explicit
Public Function control_keydown(tdat As Object, KeyCode, Optional mask As String = "dd/mm/yyyy", Optional charMASK As String = "_")
'MsgBox KeyCode
    Dim txt$, X&, plus&, longg&, sep$, mask2$
    'construction du masque de saisie(mask2) en fonction de la chaine de format de date injectée
    mask2 = Replace(Replace(Replace(mask, "d", charMASK), "m", charMASK), "y", charMASK)
    sep = Left(Replace(mask2, charMASK, ""), 1) 'determine le caractere de separation
    If tdat = "" Then tdat = mask2    'si textbox vide alors = mask2
    txt = tdat.Value: If txt = mask2 Then tdat.SelStart = 0: tdat = ""
    X = tdat.SelStart: longg = tdat.SelLength: If longg = 0 Then longg = 1
    If KeyCode = 8 And longg > 1 Then KeyCode = 46
    Select Case KeyCode
    Case 96 To 105
        If X = 10 Then KeyCode = 0: Exit Function
        If Mid(mask2, X + 1, 1) = sep Then X = X + 1
        Mid(txt, X + 1, longg) = Mid(mask2, X + 1, longg): tdat = txt: plus = IIf(KeyCode < 96, 32, -48):    'reformate si plus de 1 caractere selectionné
        Mid(txt, X + 1, 1) = Chr(KeyCode + plus): tdat = txt: tdat.SelStart = X + 1: KeyCode = 0
        If Mid(tdat, X + 2, 1) = sep Then tdat.SelStart = X + 2

        'control de validité de la date tapée a tout moment
        Dim Pos1&, Pos2&, Part1$, Part2$, Part3$, PosX&
        Select Case True    'determine les segment jours/mois/année  et les positions selstart SELON le format injecté
        Case Left(mask, 2) = "yy": Part2 = Mid(tdat, 6, 2): Part1 = Mid(tdat, 9, 2): Part3 = Mid(tdat, 1, 4): Pos1 = 8: Pos2 = 5: PosX = 8
        Case Left(mask, 2) = "mm": Part2 = Mid(tdat, 1, 2): Part1 = Mid(tdat, 4, 2): Part3 = Mid(tdat, 7, 4): Pos2 = 0: Pos1 = 3: PosX = 3
        Case Left(mask, 2) = "dd": Part1 = Mid(tdat, 1, 2): Part2 = Mid(tdat, 4, 2): Part3 = Mid(tdat, 7, 4): Pos1 = 0: Pos2 = 3: PosX = 3
        End Select

        'on ne peut depasser 31 pour les jours et 12 pour le mois quelque soit le format
        If Val(Part1) > 31 Or Val(Left(Part1, 1)) > 3 Or Part1 = "00" Then tdat.SelStart = Pos1: tdat.SelLength = 2: Beep: Exit Function
        If Val(Part2) > 12 Or Val(Left(Part2, 1)) > 1 Or Part2 = "00" Then tdat.SelStart = Pos2: tdat.SelLength = 2: Beep: Exit Function

        'quand jour et mois sont rempli on teste avec l'annéee 2000(année bissextile pour fevrier)et 30 ou 31 pour les autres mois
        If IsDate(Part1 & "/" & Part2) Then If Not IsDate(Part1 & "/" & Part2 & "/2000") Then tdat.SelStart = PosX: tdat.SelLength = 2: Beep

        If Not IsDate(tdat) And InStr(tdat, charMASK) = 0 Then    'si plus de caracteres mask on teste la date complete
            tdat.SelStart = InStrRev(tdat.Text, sep): tdat.SelLength = 4: Beep: Exit Function
        Else
            'pour pallier a l'erreur de isdate pour les année inferieur a 100 pour fevrier
            If IsDate(tdat) Then If Year(CDate(tdat)) <> Val(Part3) Then tdat.SelStart = InStrRev(tdat.Text, sep): tdat.SelLength = 4: Beep
        End If

    Case 8    'touche BACK (Retour en arrière)
        If X <> 0 Then Mid(txt, X, longg + 1) = Mid(mask2, X, longg + 1)
        tdat = txt: tdat.SelStart = X - 1: KeyCode = 0
        If tdat = mask2 Then tdat = ""
        If Mid(txt, X - IIf(X > 1, 1, 0), 1) = sep Then tdat.SelStart = X - 2
    Case 46 'touche Suppr(supprimer)
    Mid(txt, X + 1, longg) = Mid(mask2, X + 1, longg): KeyCode = 0: tdat = txt: tdat.SelStart = X    'touche Suppr

    Case 37: tdat.SelStart = X - 1    'touche fleche gauche
    Case 39: tdat.SelStart = X + 1    'touche fleche droite

    Case 13 Or 9    ' ce que l'on veux c'est la sortie

    Case Else: KeyCode = 0    'touche les autres touches sont exclues
    End Select

End Function

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    control_keydown TextBox1, KeyCode, "yyyy/mm/dd", "_"
End Sub

 

[Danielson]

Super,

Quelle rapidité Wow

Merci beaucoup !

 

[patricktoulon]

alors ca fonctionne?

 

[vincl2216]

alors ca fonctionne?

Bonjour,

Je me permets de revenir sur votre code, je testé et ce dernier m’intéresse grandement, toutefois, je ne parviens pas à sortir de la Textbox via la touche de tabulation.

Pourriez-vous m'éclairer afin que le code puisse le permettre et ainsi rendre la saisie de plusieurs textbox à la suite sans devoir changer de Textbox via la sourie ?

Merci d'avance

 

[patricktoulon]

Bonjour
donner moi un fichier avec un userform exemple
c'est etonnant le case 9(tab) et 13(enter) sont libres

 

[vincl2216]

Bonjour
donner moi un fichier avec un userform exemple
c'est etonnant le case 9(tab) et 13(enter) sont libres

Tout d'abord un grand merci pour votre réactivité.
Pour tester votre, code, je me suis contenté de l'inclure dans un fichier avec un simple userform avec deux Texbox (fichier en annexe)

J'arrive à passer du Textbox2 au Textbox1 mais pas l'inverse et ce qu'il n'y ait rien de saisi ou que la date correcte soit saisie.

 

[patricktoulon]

re
je vous ai mis la version date FR 2022
la touche tab et enter fonctionne que si le textbox est vide ou contient une date entière et valide

 

[vincl2216]

re
je vous ai mis la version date FR 2022
la touche tab et enter fonctionne que si le textbox est vide ou contient une date entière et valide

parfait, merci beaucoup