Autres Masque de saisie universel pour formats spéciaux saisis dynamiquement dans un TextBox

 Case 13:    [A1] = UCase(Tsiret)

Tsiret = UCase(txt): Tsiret.SelStart = IIf(InStr(1, Tsiret, "X") = 0, s + 1, InStr(1, Tsiret, "X") - 1)

Option Explicit
Private Sub Tsiret_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    'MsgBox KeyCode
    Dim Mask$, txt$, s&, longg&, plus&
    Mask = "XXX / XXX XX XX"
       If Tsiret = "" And KeyCode <> 8 And KeyCode <> 46 Then Tsiret = Mask
    txt = Tsiret.Value:    If txt = Mask Then Tsiret.SelStart = 0
    s = Tsiret.SelStart:
    longg = Tsiret.SelLength: If longg = 0 Then longg = 1
    plus = IIf(KeyCode < 96, 32, -48):
    Select Case KeyCode
    Case 96 To 105, 65 To 90
        If s = Len(Mask) Then KeyCode = 0: Exit Sub
        If Mid(Mask, s + 1, 1) <> "X" Then KeyCode = 0: s = s + 1: Tsiret.SelStart = s: Exit Sub
        Mid(txt, s + 1, longg) = IIf(Val(Tsiret.Tag) = 0, Chr(KeyCode + plus), UCase(Chr(KeyCode + plus))) & Mid(Mask, s + 2, longg - 1): KeyCode = 0 'new!!!
        Tsiret = txt: Tsiret.SelStart = IIf(InStr(1, Tsiret, "X") = 0, s + 1, InStr(1, Tsiret, "X") - 1)
    Case 8
        If s <> 0 Then Mid(txt, s, longg + 1) = Mid(Mask, s, longg + 1) Else Exit Sub
        Tsiret = txt: Tsiret.SelStart = s - 1: KeyCode = 0
        If txt = Mask Then Tsiret = ""
    Case 46
        If Tsiret = "" Then Exit Sub
        If longg = 0 Then longg = 1
        Mid(txt, s + 1, longg) = Mid(Mask, s + 1, longg)
        Tsiret = txt: Tsiret.SelStart = s: KeyCode = 0
        If txt = Mask Then Tsiret = ""

    Case 39: Tsiret.SelStart = s + 1
    Case 37: Tsiret.SelStart = s - IIf(s > 0, 1, 0)
    Case 20: If Val(Tsiret.Tag) = 0 Then Tsiret.Tag = 1 Else Tsiret.Tag = 0'  new!!! touche verr Maj
    Case 16:  Tsiret.Tag = 1'   new!!! touche Maj
    
    Case 13:    ' touche enter  fait ce que tu veux c'est la sortie
    Case Else: KeyCode = 0
    End Select
End Sub
'                                            new!!!'
'gestion du relâchement de la touche Maj
Private Sub Tsiret_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 16 Then Tsiret.Tag = 0
End Sub

Private Sub TextBox1_GotFocus()
TextBox1_Change
End Sub

Private Sub TextBox1_Change()
Dim x$, t$, i%, j%, pos%
x = "- -- -- -- --- --- --" 'masque de saisie avec tirets et espaces
t = Replace(Replace(TextBox1, "-", ""), " ", "")
For i = 1 To Len(t)
    For j = j + 1 To Len(x)
        If Mid(x, j, 1) = "-" Then
            x = Left(x, j - 1) & Mid(t, i, 1) & Mid(x, j + 1)
            pos = j
            Exit For
        End If
Next j, i
If Mid(x, pos + 1, 1) = " " Then pos = pos + 1
TextBox1 = x
TextBox1.SelStart = pos
TextBox1.SelLength = 1
End Sub

Option Explicit

Private Sub TextBox1_GotFocus()
    TextBox1_Change
End Sub

Private Sub TextBox1_Change()
    Dim x$, t$, i%, j%, pos%
    x = "- -- -- -- --- --- --"    'masque de saisie avec tirets et espaces
    t = Replace(Replace(TextBox1, "-", ""), " ", "")
    For i = 1 To Len(t)
        pos = InStr(x, "-")
        If pos <> 0 Then Mid$(x, pos, 1) = Mid$(t, i, 1)
    Next i
    TextBox1 = x
    TextBox1.SelStart = pos + IIf(Mid$(TextBox1, TextBox1.SelStart + 1, 1) = " ", 1, 0)
    TextBox1.SelLength = 1
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 8 Then retour = True: TextBox1_Change: retour = False
If TextBox1.SelLength < 2 Then If KeyCode = 46 Then KeyCode = 0: TextBox1.SelLength = 1 'touche suppr
End Sub

Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Cancel = True
TextBox1.SelLength = 1
End Sub