Saisir une date ou un nombre dans un userform

Hello X Cellus ...

Intéressant pour la couleur qui indique une anomalie.

Peux-tu me dire quel est l'effet induit par ceci, car je suppose que cela doit mettre un / entre le jour et le mois, et entre le mois et l'année

If Len(TxtDate) = 1 Or Len(TxtDate) = 4 Then SendKeys ("/")

chez moi il ne se passe rien (excel 2013), mais j'ai peut-être loupé un épisode ! merci d'avance.

En effet Steelson, après deux chiffres pour le jour, un / se place en 3ième position. De même après 2 chiffres après le mois.

Vu que je demande une date en format jj/mm/aaaa

l'idée est intéressante, est-ce que cela fonctionne chez toi en 2007 comme en 365 ?

j'ai parfois remarqué des écarts dans les controlX d'une version d'excel à l'autre

Pour le besoin du membre je l'ai fait en version 2007 d'Excel de mon ancien ordi.

Je vais tester sur l'autre ordi, celui avec 365. Pour contrôle.

Après test sur plusieurs dates c'est bon.

Peut être un léger ralentissement dû au fait que je suis sur plusieurs fichiers actuellement et sur le Web en plus.

Par contre vu que ces Activex sont placés sur la feuille et non sur un formulaire.

Cela peut induire pour le sendkey une mauvaise anticipation. J'utilise le clavier numérique.

Je viens de voir qu'il y a parfois la dévalidation du clavier numérique.

Sympa ton code patricktoulon qui garde le signe '€' dans une TextBox !

J'ai essayé avec le code de patricktoulon et mes connaissances de faire un TextBox pour une date FR seulement + masque (j'aime l'idée du masque ahah).

Voici la V1, améliorable je pense :

Private Sub TextBox_Date_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

    Dim Masque As String, TexteDate As String
    Dim PositionCurseur As Byte

    TextBox_Date.MaxLength = 10

    Masque = "__/__/20__"

    If KeyCode >= 48 And KeyCode <= 57 Then KeyCode = KeyCode + 48 'conversion du keycode du pavé haut du clavier

    If TextBox_Date.Value = "" Then TextBox_Date.Value = Masque: TextBox_Date.SelStart

    TexteDate = TextBox_Date
    PositionCurseur = TextBox_Date.SelStart

    Select Case KeyCode
        Case 96 To 105  'pavé numerique
                plus = IIf(KeyCode < 96, 32, -48)
                If InStr(1, TextBox_Date, "_") = 0 Then Exit Sub Else Mid(TexteDate, InStr(1, TexteDate, "_"), 1) = Chr(KeyCode + plus)
                TextBox_Date = TexteDate
                If PositionCurseur = 1 Then
                    TextBox_Date.SelStart = PositionCurseur + 2
                ElseIf PositionCurseur = 4 Then
                    TextBox_Date.SelStart = PositionCurseur + 4
                Else
                    TextBox_Date.SelStart = PositionCurseur + 1
                End If

                If Len(TextBox_Date) = 10 And InStr(1, TextBox_Date, "_") = 0 Then
                    If IsDateFR(TextBox_Date) = False Then MsgBox "La date n'est pas valide !": TextBox_Date = "": Beep: KeyCode = 0
                End If

        Case 8
            If PositionCurseur = 0 Then Exit Sub
            If PositionCurseur <> 0 Then Mid(TexteDate, PositionCurseur, 1) = Mid(Masque, PositionCurseur, 1)
            TextBox_Date = TexteDate: TextBox_Date.SelStart = PositionCurseur - 1: KeyCode = 0
            If TextBox_Date = Masque Then TextBox_Date = ""
            If PositionCurseur = 9 Then TextBox_Date.SelStart = PositionCurseur - 4
            If PositionCurseur = 4 Then TextBox_Date.SelStart = PositionCurseur - 2
        Case 46 'touche Suppr(supprimer)
            If PositionCurseur = 10 Then Exit Sub
            Mid(TexteDate, PositionCurseur + 1, 1) = Mid(Masque, PositionCurseur + 1, 1): KeyCode = 0: TextBox_Date = TexteDate: TextBox_Date.SelStart = PositionCurseur    'touche Suppr
        Case 37: If PositionCurseur = 0 Then Exit Sub: TextBox_Date.SelStart = PositionCurseur - 1: KeyCode = 0   'touche fleche gauche
        Case 39: TextBox_Date.SelStart = PositionCurseur + 1: KeyCode = 0    'touche fleche droite
        Case Else: Exit Sub    'touche les autres touches sont exclues

    End Select

End Sub

Function IsDateFR(ByVal dat As Variant) As Boolean
'nous voulons avoir que le format "dd/mm/yyyy" (europe)qui soit validé
If IsDate(dat) Then IsDateFR = Format(dat, "dd/mm/yyyy") = dat And Len(dat) = 10
End Function

EDIT : @X Cellus ; @Steelson

Perso j'ai aussi un problème avec le clavier numérique. J'appuie sur shift + je tape mes nombres. Aucun soucis pour les jours, le slash se place bien puis après ça part en sucette, cela ne tape plus les chiffres mais les caractères présents sur les touches des chiffres...

J'aime bien l'idée du masque en effet, fabuleux !

J'aime bien l'idée d'X Cellus sur la couleur qui indique une erreur de date.

J'aime bien les échanges constructifs et respectueux.

J'aime bien aussi les codes minimalistes.

Et j'étais en train justement de voir comment simplifier une des propositions en y intégrant l'idée d'X Cellus sur les couleurs, (mais sans le sendkeys qui ne donne rien chez moi ! pfttt )

Bonjour a tous

reponse a l'essaie de Steelson

une image parle mieux que des mots

la on a le jour qui n'est pas vérifié et le mois non valide qui est est détecté mais marqué quand même

et a la ré rédaction c'est pire on perd des chiffres

non la "minimale" je l'ai donné pour rédaction à but école ,elle ne gère pas tout

croyez moi vous êtes loin avec ces raisonnements je m'y suis cassé le nez pendant des heures il y a quelques années

ça parait tout simple mais en fait c'est beaucoup plus complexe que ca pour gérer toutes les éventualités

c'est pour ça que mes fonctions sont verbeuses

en gros il faut que vous arriviez a transformer le textbox en 3 entité différentes jj mm yyyy comme je le fait dans la fonction

ci dessous ta démo Steelson

et oublie ce keyup c'est pas bon tu n'a pas l'anticipation avec cet event

demo6

en tout cas ravi que ça intéresse du monde c'est vrai c'est pas trop important mais c'est un exercice intéressant

peu être trouverez vous des solutions plus simples que les miennes

Patrick, ce n'est pas une cour de récréation, mais je te remercie pour tes commentaires, sincèrement (d'autant que j'aurais appris des choses)

  • j'ai bien dit " en version courte avec les mêmes fonctionnalités " et comme tu le mentionnes aussi de ton côté " elle ne gère pas tout "
  • je suis en train de voir avec l'idée d X Cellus pour contrôler aussi a minima le jour et la mois sans chercher à faire du 100%
  • pour le keyup je suis d'accord
  • pour la solution la plus simplissime, pour moi, elle existe, c'est la solution sans code

Salut patricktoulon,

L'idée de base était aussi de ne pas forcément vérifier les jours, puis ensuite les mois mais la date globale quand 10 caractères sont entrés. Laisser l'utilisateur entrer sa date, la vérifier, lui indiquer si elle est fausse et si c'est le cas, le laisser recommencer

Bonjour à tous,

@Baboutz.

Effectivement le but n'étant pas de tout contrôler mais d'éviter qu'un utilisateur puisse valider au final une date incorrecte.

@Steelson.

Pour les versions d'Excel après 2007. En retour adaptation avec un formulaire. Clic sur le bouton AppelBoxDate.

Le Sendkey ajoutant un / a été abandonné. A la place ce / est simulé à l'écran et la vérification de la date est sous-traitée par des contrôles annexes rendus invisibles.

A compléter selon besoin...

10textboxdate2.xlsm (55.13 Ko)

@ X Cellus ... malin !

Bon, alors j'y vais aussi ... j'ai intégré ta couleur magenta dont j'aime bien l'idée

Private Sub DateBox1_KeyPress(ByVal KeyCode As MSForms.ReturnInteger)
    If InStr("0123456789", Chr(KeyCode)) = 0 Then KeyCode = 0
End Sub

Private Sub DateBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    DateBox1.BackColor = vbWhite
    DateBox1.MaxLength = 10
    tbl = Split(DateBox1, "/")
    n = UBound(tbl)
    Select Case n
        Case Is = 0: If Len(DateBox1) > 1 Then DateBox1 = Left(DateBox1, 2) & "/"
        Case Is = 1: DateBox1 = Left(tbl(0), 2) & "/" & Left(tbl(1), 2): If Len(tbl(1)) > 1 Then DateBox1 = DateBox1 & "/"
        Case Is = 2: DateBox1 = Left(tbl(0), 2) & "/" & Left(tbl(1), 2) & "/" & Left(tbl(2), 4)
    End Select
    If n >= 0 Then If Left(tbl(0), 2) > 31 Then DateBox1.BackColor = vbMagenta
    If n >= 1 Then
        If Left(tbl(1), 2) > 12 Then DateBox1.BackColor = vbMagenta
        If Not IsDate(Left(tbl(0), 2) & "/" & Left(tbl(1), 2) & "/2000") Then DateBox1.BackColor = vbMagenta
    End If
    If n >= 2 Then If Len(tbl(2)) = 4 And Not IsDate(DateBox1) Then DateBox1.BackColor = vbMagenta
End Sub

si quelqu'un casse le code, je serais content, cela veut dire que j'ai encore un potentiel d'amélioration !

A nouveau,

Je télécharge aussi ton fichier. Cela peut aider pour des textbox de petite taille.

J'ai pas essayé encore de réduire la taille du textbox utilisé dans mon fichier afin de voir s'il passe partout. Ce week-end sans doute.

bonsoir Steelson

oui en rédaction ca peu aller mais à la reprise ça casse la chaîne

crois moi si je te dit que travailler sur la chaîne par segment ne suffit pas ,c'est que j'en ai fait le tour

pour gérer une chaine formatée il te faut gérer ça dans un

exemple simpliste

select case keycode
  case x to y
     selelect case .selstart
       case a,b
       case c,d
       etc..
       etc...
    end select
end select

sans ça tu aura toujours une fuite

et par expérience il est préférable de travailler avec un masque de saisie c'est un repère constant même invisible s'il le faut

bref je vous en ai donné 2 fonctionnelles

Baboutz j'ai testé ton code

dis moi un peu a quoi sert le controle de saisie si c'est pour avoir la réponse qu'a la fin

en plus tu t'es largement inspiré du mien mais tu a raté l'essentiel

tu avais fait un oubli aussi que j'ai marqué en rouge

capture

et le test

des le départ (ca tu peux pas le faire sur un de mes deux exemples

demo7

prends le temps analyse bien et si tu ne comprends pas pourquoi je fait ceci ou cela demande moi j'expliquerais volontiers

Salut patricktoulon,

L'idée de base était aussi de ne pas forcément vérifier les jours, puis ensuite les mois mais la date globale quand 10 caractères sont entrés. Laisser l'utilisateur entrer sa date, la vérifier, lui indiquer si elle est fausse et si c'est le cas, le laisser recommencer

dans ce cas là le contrôle de saisie n'a pas lieu d’être

tester avec ma petite fonction isdateFR au len(10) et puis c'est tout

mais là on parle plus de datebox

@patricktoulon

  • le principal objectif pour moi était bien de :
    • contrôler une date entrée
    • et contrôler que le mois soit bien inférieur à 12 sans quoi excel pourrait prendre le mois pour le jour et le jour pour le mois
    • le reste, pour le fun, est un peu d'habillage pour peu que le verrou final soit efficace
    • de toute façon chacun sait que je n'aime pas travailler avec des userform que microsoft n'a pas réellement mis au même niveau qu'une feuille (validation des entrées, formats dates et nombres etc.)
  • autre question, je profite de tes compétences :
    • est-il possible avec ton système de présenter une saisie
      • d'un nombre décimal avec virgule (et non point)
      • et avec séparateur des milliers/millions comme le demandait un participant ?

Merci d'avance

Bonjour à tous,

Version définitive du BoxDate par formulaire. Toujours clic sur le bouton Appel BoxDate.

11textboxdate3.xlsm (57.08 Ko)

Sauf à y inscrire le Saint du Jour...

RE vite fait comme ça une éprouvette jusqu'au décilliard

autre question, je profite de tes compétences :

est-il possible avec ton système de présenter une saisie

d'un nombre décimal avec virgule (et non point)

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'If InStr(1, "0123456789.,", Chr(KeyAscii)) <> 0 Then KeyAscii = 0: Exit Sub
    With TextBox1
        t = .Value & " "
        x = .SelStart
        .SelLength = 0
        Mid$(t, x + 1, 1) = Chr(KeyAscii)
        t = Replace(t, " ", "")
        forme = Application.Rept(" @@@", 34)
        t = Format(t, forme)
        .Value = Trim(t): KeyAscii = 0
        .SelStart = x + 1
        If .SelStart = Len(.Value) - 1 Then .SelStart = x + 2
    End With
End Sub

Intéressant, pas mal, je vais creuser (pour le moment je n'ai pas la décimale et si je reviens en arrière modifier ou supprimer je n'ai plus les groupes de 3 chiffres, mais je vais regarder sur cette base? à moins que tu ne poursuives de ton côté)

Rechercher des sujets similaires à "saisir date nombre userform"