Texbox(USf) : Bloquer les "/" du Format date ??/??/????

Bonjour

Dans les USf du fichier joint, j'ai plusieurs textbox qui doivent recevoir une date du type jj/mm/aaaa.

La textbox fonctionne correctement mais je souhaiterais que des séparateurs de date ("/") soient bloqués et que des ? apparaissent au départ (création et initialisation) et que lorsque l'on entre la date, ils disparaissent au fur et à mesure, remplacés par des chiffres

j'avais tenté par exemple dans l usfsource le code ci dessous sans succès

Me.Txt_Datesource = "??" & "/" & "??" & "/" & "????"

La question était déjà posée dans un autre post

https://forum.excel-pratique.com/excel/useform-comment-modifier-et-supprimer-un-enregistrement-t46418-10.html

mais maintenant elle a un post spécifique, ce qui lui permet d'être traitée plus facilement

Merci de votre aide

Cordialement

Etoile

Bonjour et bonne année,

Un début de piste mais sans masque de saisie (plus compliquer à gérer) :

Private Sub TextBox1_Change()

    'ajoute les slachs automatiquement
    If Len(TextBox1.Text) = 2 Or Len(TextBox1.Text) = 5 Then TextBox1.Text = TextBox1.Text & "/"

End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    If Len(TextBox1.Text) < 10 Then MsgBox "La date doir être au format 'jj/mm/aaaa' !"

End Sub

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    Select Case KeyAscii

        Case 47 To 57 'seulement numérique

        Case Else

            KeyAscii = 0

    End Select

    'interdit le dépacement
    If Len(TextBox1.Text) = 10 Then KeyAscii = 0

End Sub

Hervé.

Bonjour Theze, le forum

Merci pour ta réponse

je vais coller ton code dans le fichier (cj joint)

dans la feuilleSource (Txt_Datesource)

dans la feuille Compéts (Txt_DateCompet)

Bonne journée

Etoile

Bonjour Theze et Forum

J'ai disposé ton code à la suite du code de mon USf Source (en changeant avec le bon nom du txtbox)

puis j'ai appelé les procédure depuis la procédure de validation Private Sub Cmd_ValidSource_Click()

Mais le changement souhaité ne se fait pas.

J'ai dû oublier quelque chose, ou une valeur mais quoi et où?

Peux tu y jeter un oeil ?

merci

Cordialement

Etoile

Private Sub Cmd_ValidSource_Click()
' Valider/Modifier
Dim Recherche As String
Dim Cel As Range
Dim Ligne As Long
Dim Msg As String
Dim Ctrl As Control

'Contrôle de la date créée
  'Hervé info sub
  TextBox1_Change
  TextBox1_Exit
  TextBox1_KeyPress

  ' Contrôle les données saisies
  If Me.Txt_NomSource = "" Or Me.Txt_ResumeSource = "" Or Not IsDate(Me.Txt_Datesource) Then
    MsgBox "Nom Source, Résumé et Date obligatoires", vbExclamation, strAppName
    Me.Txt_NomSource.SetFocus
    Exit Sub
  End If

  For Each Ctrl In Me.Fr_TypeSource.Controls
    If TypeOf Ctrl Is MSForms.OptionButton Then
      If Ctrl = True Then
        Msg = Ctrl.Caption
      End If
    End If
  Next Ctrl

  If Msg = "" Then

    MsgBox "Type Source obligatoire", vbExclamation, strAppName
    Me.Opt_Internet.SetFocus
    Exit Sub
  End If

  With WsBase
    If Me.Txt_CodeSource <> "" Then   ' Enregistrement existant
      Set Cel = .Columns("G").Find(what:=Me.Txt_CodeSource, LookIn:=xlValues, lookat:=xlWhole)
      If Not Cel Is Nothing Then
        If MsgBox("Voulez vous modifier l'enregistrement de " & Me.Txt_NomSource & " " & Me.Txt_NumSource & " ?", _
                                          vbQuestion + vbYesNo, "Modification") <> vbYes Then Exit Sub
        Ligne = Cel.Row
      Else
        MsgBox "Ne doit jamais arriver"
        End
      End If
    Else                ' Enregistrement à priori non existant
      Recherche = Me.Txt_NomSource & " " & "-" & Me.Txt_NumSource & "-" & Me.Txt_Datesource
      Set Cel = .Columns("G").Find(what:=Recherche, LookIn:=xlValues, lookat:=xlWhole)
      If Not Cel Is Nothing Then
        If MsgBox("Voulez vous modifier l'enregistrement de " & Me.Txt_NomSource & " " & Me.Txt_NumSource & " ?", _
                                          vbQuestion + vbYesNo, "Modification") <> vbYes Then Exit Sub
        Ligne = Cel.Row
      Else
        Ligne = .Range("B" & Rows.Count).End(xlUp).Row + 1
        Me.Txt_NumenrSource = Application.max(.Columns("A")) + 1
      End If
    End If

    .Range("A" & Ligne) = CInt(Me.Txt_NumenrSource) 'CInt pour avoir une valeur numérique et non une valeur texte
    .Range("B" & Ligne) = Msg
    .Range("C" & Ligne) = Me.Txt_NomSource
    .Range("D" & Ligne) = Me.Txt_NumSource.Value
    .Range("E" & Ligne) = CDate(Me.Txt_Datesource.Value)
    .Range("F" & Ligne) = Me.Txt_ResumeSource

    .Range("G" & Ligne) = .Range("F" & Ligne) & "-" & .Range("D" & Ligne) & "-" & .Range("E" & Ligne)   ' Code athlète
  End With

'  Tri_Sources        ' Tri des Sources pas utile car toujours trié suivant la colonne A
  Affiche_Source    ' Réaffiche la liste des Sources
  Init_Source

End Sub

Private Sub Cmd_FermerSource_Click()
' Fermeture du formulaire après demande de confirmation
  If MsgBox("Confirmez-vous la fin de la saisie ?", vbQuestion + vbYesNo, strAppName) = vbYes Then Unload Me
End Sub

Private Sub Cmd_NewSource_Click()
' Initialisation de la fiche Source
  Init_Source
End Sub

Private Sub Cmd_SuppSource_Click()
'Supprimer une Source
Dim Ligne As Long

  If Me.lst_Sources.ListIndex = -1 Then
    MsgBox "Vous devez choisir une source dans la liste à droite"
    Exit Sub
  End If
  If MsgBox("Confirmez-vous la suppression de " & Me.Txt_NomSource & " " & Me.Txt_NumSource & "du " & Me.Txt_Datesource & " ?", _
                                          vbQuestion + vbYesNo, strAppName) = vbYes Then

    Ligne = Me.lst_Sources.ListIndex + 4
    With WsBase
      .Range("A" & Ligne & ":G" & Ligne).Delete shift:=xlShiftUp
      Ligne = .Range("A" & Rows.Count).End(xlUp).Row
      .Range("A4") = 1
      If Ligne > 4 Then
        .Range("A4").AutoFill .Range("A4:A" & Ligne), xlFillSeries
      End If
    End With

    Affiche_Source    ' Réaffiche la liste des Sources
    Init_Source

  End If

End Sub

Private Sub Init_Source()
' A éviter de nommer des variables avec des noms "réservés" (Exemple : max )
Dim LeMax As Integer

  '  Réinitialise le formulaire pour la saisie suivante
  LeMax = Application.WorksheetFunction.max(Range("A:A"))
  Me.Txt_NumenrSource = LeMax + 1
  Me.Opt_Internet = False
  Me.Opt_Livre = False
  Me.Opt_Autre = False
  Me.Opt_Annuel = False
  Me.Opt_Mensuel = False
  Me.Opt_Hebdo = False
  Me.Opt_Quotidien = False
  Me.Txt_CodeSource = ""
  Me.Txt_NomSource = ""
  Me.Txt_NumSource = "??"
  Me.Txt_Datesource.Value = "??/??/????"
  Me.Txt_ResumeSource = ""

End Sub

Private Sub lst_Sources_Click()
Dim Ligne As Long
Dim Ctrl As Control

  Init_Source
  ' Affichage de la Source sélectionnée
  Ligne = Me.lst_Sources.ListIndex + 4

  With WsBase
  'n° enregistrment source
    Me.Txt_NumenrSource = .Range("A" & Ligne)
    'type source
    For Each Ctrl In Me.Fr_TypeSource.Controls
      If TypeOf Ctrl Is MSForms.OptionButton Then
        If Ctrl.Caption = .Range("B" & Ligne) Then
          Ctrl = True
        End If
      End If
    Next Ctrl

    Me.Txt_NomSource = .Range("C" & Ligne)
    Me.Txt_NumSource = .Range("D" & Ligne)
    Me.Txt_Datesource = .Range("E" & Ligne)
    Me.Txt_ResumeSource = .Range("F" & Ligne)
    Me.Txt_CodeSource = .Range("G" & Ligne)
  End With
End Sub

Bonjour,

Les proc que j'ai posté sont des procédures évènementielles qui sont donc exécutées lors de tout changement dans la TextBox "Txt_Datesource". Elles doivent être intégrées dans ton code de la façon suivante afin que l'action effectuée déclanche l'exécution du code correspondant :

    Private Sub Txt_Datesource_Change()

        'ajoute les slachs automatiquement
       If Len(Txt_Datesource.Text) = 2 Or Len(Txt_Datesource.Text) = 5 Then Txt_Datesource.Text = Txt_Datesource.Text & "/"

    End Sub

    Private Sub Txt_Datesource_Exit(ByVal Cancel As MSForms.ReturnBoolean)

        If Len(Txt_Datesource.Text) < 10 Then MsgBox "La date doit être au format 'jj/mm/aaaa' !"

    End Sub

    Private Sub Txt_Datesource_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

        Select Case KeyAscii

            Case 47 To 57 'seulement numérique

            Case Else

                KeyAscii = 0

        End Select

        'interdit le dépacement
       If Len(Txt_Datesource) = 10 Then KeyAscii = 0

    End Sub

Hervé.

Bonjour Hervé

Merci pour les procédures.

Je les collées à la fin de mon code dans l'USf

Mais j'ai un msg d'erreur

Erreur de compilation : nom ambigu

Private Sub Txt_Datesource_Exit(ByVal Cancel As MSForms.ReturnBoolean)

Merci

Etoile

Bonjour,

Private Sub Txt_Datesource_Exit(ByVal Cancel As MSForms.ReturnBoolean)

Tout simplement parce que cette procédure existe déjà dans ton code, il te faut fusionner les linges de code dans la même procédure évènementielle mais pour le test, mets ta procédure "Txt_Datesource_Exit" en commentaire afin que le compilateur n'en tienne plus compte et teste.

Hervé.

Bonjour Hervé,, Le forum

Merci beaucoup.

Effectivement j'avais la private sub en double.

Maintenant tes procédures fonctionnent dans l'USf Source de la feuille Source

Cependant, comme j'ai mis

Me.Txt_Datesource.Value = "??/??/????"

lors de l'initialisation des txtbox,

lorsque je passe de txtbox en txbox (via la touche tab), arrivée à la txtbox txt_DateSource,

les "?" ne s'effacent aps au fur et à mesure que je rentre la date.

Aurais tu une idée de plus pour que cela se fasse ou est ce impossible?

merci

Etoile