Saisir une date au format xx/xx/xx

Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean) 
If Not IsDate(TextBox4) Then 
Cancel = True 
End If 
End Sub

Option Explicit

    'TEXTBOX1 = Sécurité sociale
    Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
        If Len(TextBox1) <> 15 Then Cancel = True
    End Sub

    Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
        If Len(TextBox1.Text) = 15 And KeyCode <> 46 And KeyCode <> 8 Then KeyCode = 0: Exit Sub
        Select Case KeyCode
            Case 96 To 105  'chiffres pavé numérique
                If Shift = 1 Then KeyCode = 0
            Case 48 To 57   'chiffre touches clavier alphanumérique
                If Shift = 0 Then KeyCode = 0
            Case 8, 9, 16, 46  'touches retour arrière, TAB, Shift, Suppr
                'action à voir
            Case Else
                KeyCode = 0
        End Select
    End Sub

    'TEXTBOX2 = NOM
    Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
        If TextBox2.Text = "" Then Cancel = True
    End Sub

    Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
        Select Case KeyAscii
            Case 32 'espace
                KeyAscii = 0
            Case 45  'trait d'union
                If Len(TextBox2.Text) = 0 Then KeyAscii = 0
            Case 65 To 90 'majuscules
            Case 97 To 122 'minuscules
                KeyAscii = KeyAscii - 32
            Case Else
                KeyAscii = 0
        End Select
    End Sub

    'TEXTBOX3 = Prenom
    Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
        If TextBox3.Text = "" Then Cancel = True
    End Sub
    
    Private Sub TextBox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
        Select Case KeyAscii
            Case 32 'espace
                KeyAscii = 0
            Case 45  'trait d'union
                If Len(TextBox3.Text) = 0 Then KeyAscii = 0
            Case 65 To 90 'majuscules
                If Len(TextBox3.Text) > 0 Then KeyAscii = 0
            Case 97 To 122 'minuscules
                If Len(TextBox3.Text) = 0 Then KeyAscii = KeyAscii - 32
            Case Else
                KeyAscii = 0
        End Select
    End Sub
    
    'TEXTBOX4 = Date
    Private Sub TextBox4_Exit(ByVal Cancel As MSForms.ReturnBoolean)
        If TextBox4.Text <> "" And Len(TextBox4.Text) < 10 Then
            Cancel = True
        Else
            If TextBox4.Text <> "" Then TextBox4.Tag = TextBox4.Text
        End If
    End Sub

    Private Sub TextBox4_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
        teste_date ActiveControl, KeyCode, "##/##/####", False
    End Sub
    
    'TEXTBOX5 = Date
    Private Sub TextBox5_Exit(ByVal Cancel As MSForms.ReturnBoolean)
        If TextBox5.Text <> "" And Len(TextBox5.Text) < 10 Then
            Cancel = True
        Else
            If TextBox5.Text <> "" Then TextBox5.Tag = TextBox5.Text
        End If
    End Sub

    Private Sub TextBox5_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
        teste_date ActiveControl, KeyCode, "##/##/####", False
    End Sub
    
    
    '-----------------------------------------------------------------
    'http://codes-sources.commentcamarche.net/forum/oldest/10059886-textebox-en-forme-date#14
    Private Sub teste_date(ByRef t As MSForms.TextBox, ByRef cod As MSForms.ReturnInteger, ByVal flt As String, scl As Boolean)
    Dim ici As Byte, sp As String, cr As String, drf As String, dtt As String, siecle As Boolean
        sp = Left(Replace(flt, "#", ""), 1)
        drf = "31" & sp & "12" & sp & "2000" 'ne touche jamais rien à cette chaine
        With t
            ici = .SelStart
            If cod = 46 And .SelText = Mid(.Text, ici + 1) Then
                .Text = Left(.Text, ici)
                If Len(.Text) = 2 Or Len(.Text) = 5 Then .Text = Left(.Text, Len(.Text) - 1)
                cod = 0: Exit Sub
            End If
            If ici < Len(.Text) Then .SelStart = Len(.Text): cod = 0: Exit Sub
            If cod = 8 Then
                If ici = 3 Or ici = 6 Then .Text = Left(.Text, Len(.Text) - 1)
                Exit Sub
            End If
            If cod = 37 And ici = 0 Then
                If IsDate(.Tag) Then .Text = .Tag: cod = 0: Exit Sub
            End If
            If cod > 95 Then cr = Chr(cod - 48)
            If ici = 3 Then Mid(drf, 1, 5) = IIf(cr = "0", "00" & sp & "01", "00" & sp & "02")
            dtt = .Text & cr & Mid(drf, ici + 2)
            If cod = 32 Then
                If ici = 0 Or ici = 3 Or ici = 6 Or ici = 8 Then
                    Dim voir As String
                    voir = .Text & Mid(Format(Date, "dd" & sp & "mm" & sp & "yyyy"), ici + 1)
                    If IsDate(voir) Then .Text = voir
                End If
                cod = 0:   Exit Sub
            End If
            If ici <> 8 Then
                If Not IsDate(dtt) Or Not dtt Like flt Then cod = 0: Exit Sub
            Else
                If Not IsNumeric(cr) Then cod = 0: Exit Sub
            End If
            Select Case ici
                Case 1, 4
                    If ici = 4 And Val(Mid(.Text, ici, 1) & cr) > 12 Then cod = 0: Exit Sub
                    If ici = 4 And scl Then
                        .Text = Left(dtt, Len(.Text & cr)) & sp & Int(Year(Date) / 100): cod = 0
                    Else
                        .Text = Left(dtt, Len(.Text & cr)) & sp: cod = 0
                    End If
                Case 3
                    If cr > "1" Then cod = 0
            End Select
        End With
        Application.CutCopyMode = True
    End Sub