' à mettre dans l'userform
' --------------- 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
End Sub
'Controle validité de la date saisie
Private Sub TextBox1_change()
Dim Validite As Boolean
Call ValidationDate(UserForm1.TextBox1, Validite)       'UserForm1
End Sub
' =============== Routine de validation de date à la saisie dans Textbox ============
'================              Dans un module standard                   ============
'
Sub ValidationDate(TextBox1 As Object, Valide As Boolean)
Dim reponse As Variant
Dim LaDate As String
'
2 Select Case Len(TextBox1.Value)
    Case 1
        If CLng(TextBox1.Value) > 3 Then
            reponse = MsgBox("Le jour ne peut pas commencer par " & TextBox1.Value, vbOKOnly, "Erreur de saisie")
            TextBox1.Value = ""
            Exit Sub
        End If
    Case 2
        If CLng(TextBox1.Value) > 31 Then
            reponse = MsgBox("Le mois ne peut avoir plus de 31 jours", vbOKOnly, "Erreur de saisie")
            TextBox1.Value = Left(TextBox1.Value, 1)
            Exit Sub
        Else
            TextBox1.Value = TextBox1.Value & "/"
        End If
    Case 4
        If Right(TextBox1.Value, 1) > 1 Then
            reponse = MsgBox("L'année ne peut avoir plus de 12 mois", vbOKOnly, "Erreur de saisie")
            TextBox1.Value = Left(TextBox1.Value, 3)
            Exit Sub
        End If
    Case 5
        If CLng(Right(TextBox1.Value, 2)) > 12 Then
            reponse = MsgBox("L'année ne peut avoir plus de 12 mois", vbOKOnly, "Erreur de saisie")
            TextBox1.Value = Left(TextBox1.Value, 4)
            Exit Sub
        Else
            TextBox1.Value = TextBox1.Value & "/"
        End If
    Case 8
    LaDate = Left(TextBox1.Value, 6) & "20" & Right(TextBox1.Value, 2)
    If Not IsDate(LaDate) Then
        reponse = MsgBox("Le " & TextBox1.Value & " n'existe pas ", vbOKOnly, "Erreur de saisie")
        TextBox1.Value = ""
        Exit Sub
    End If
  
    Valide = True
End Select
End Sub