Collection de textbox formatés avec masque de saisie

Bonjour a tous je vous propose une partie de ma collection de textboxs formatés avec masque de saisie dans leur versions basiques

chaque exemple est fourni avec exemple d'appel dans l'event KEYdown

un datebox format FR "DD/MM/YYYY"

'********************************************************************
'COLLECTION TEXTBOX FORMATE EPISODE 1 EXERCICE 1                    *
'         UN DATEBOX avec masque de saisie format FR                *
'en version simplifié a but école                                   *
'auteur patricktoulon sur exceldownload et excel pratique           *
'version 3.7                                                        *
'                                                                   *
'le moteur séparé de l'event pour utilisation multi textbox         *
'********************************************************************
Option Explicit
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
CtrL_KeyDown TextBox1, KeyCode
End Sub

Private Sub CtrL_KeyDown(ByVal TxtB As MSForms.TextBox, ByVal KeyCode As MSForms.ReturnInteger)
    Dim X&, Xl&, D$, M$, A, T$, mask, C2, D2: mask = "__/__/____"
    'pour ceux qui n'ont pas le pavé numerique conversion du keycode du pavé haut du clavier
    If KeyCode >= 48 And KeyCode <= 57 Then KeyCode = KeyCode + 48
    'c'est parti on démarre le controle!!
    With TxtB
        Xl = .SelLength: If Xl = 0 Then Xl = 1    'Xl= la longeur de texte selectionné
        .Value = IIf(.Value = "", mask, .Value): If KeyCode = 8 And Xl > 1 Then KeyCode = 46
        T = .Value: .SelStart = IIf(T = mask, 0, .SelStart): X = .SelStart:
        Select Case KeyCode
        Case 96 To 105  'pavé numerique haut et bas (Attention!!!pas besoins de bloquer la touche MAJ!!!!!!!!le code se charge de convertir)
            If X = 10 Then KeyCode = 0: Exit Sub
            If X = 2 Or X = 5 Then X = X + 1
            Mid(T, X + 1, Xl) = Chr(KeyCode - 48) & Mid(mask, X + 2, Xl - 1)
            X = X + 1: Xl = 0: If X = 2 Or X = 5 Then X = X + 1
            'le plus gros tu traitement se passe avec controle de validité de date en fait!!!
            If Val(T) > 31 Or Val(Mid(T, 1, 1)) > 3 Then X = 0: Xl = 2: Mid(T, 1, 2) = Mid(mask, 1, 2): Beep
            If Val(Mid(T, 4, 2)) > 12 Or Val(Mid(T, 4, 1)) > 1 Then Mid(T, 4.2) = Mid(mask, 4, 2): X = 3: Xl = 2: Beep
            D = Mid(T, 1, 2): M = Mid(T, 4, 2): A = Mid(T, 7, 4)
            If IsDate(D & "/" & M) And Not IsDate(D & "/" & M & "/2000") Then Mid(T, 4, 2) = Mid(mask, 4, 2): X = 3: Xl = 2: Beep: KeyCode = 0
            If X = 10 And Not IsDate(T) Then Mid(T, 7, 10) = Mid(mask, 7, 10): X = 6: Xl = 4: Beep

        Case 8:
            If X = 0 Then KeyCode = 0:: .Value = "": Exit Sub Else Mid(T, X, 1) = Mid(mask, X, 1): X = X - 1: Xl = 0
            If T = mask Then T = ""
        Case 46:
            If X = 10 Then Exit Sub Else Mid(T, X + 1, Xl) = Mid(mask, X + 1, Xl): X = X: Xl = 0: If X = 2 Or X = 5 Then X = X + 1
            If T = mask Then T = ""
        Case Else: KeyCode = 0    ' a pour effet d'inhiber toutes les autre touches
        End Select
        .Value = T 'restitution
        .SelStart = X: .SelLength = Xl: KeyCode = 0
    End With
End Sub

datebox US format "MM/DD/YYYY"

'********************************************************************
'COLLECTION TEXTBOX FORMATE EPISODE 1 EXERCICE 1                    *
'         UN DATEBOX avec masque de saisie format US                *
'en version simplifié a but école                                   *
'auteur patricktoulon sur exceldownload et excel pratique           *
'version 3.7                                                        *
'                                                                   *
'le moteur séparé de l'event pour utilisation multi textbox         *
'********************************************************************
Option Explicit
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
CtrL_KeyDown TextBox1, KeyCode
End Sub

Private Sub CtrL_KeyDown(ByVal TxtB As MSForms.TextBox, ByVal KeyCode As MSForms.ReturnInteger)
    Dim X&, Xl&, D$, M$, A, T$, mask, C2, D2: mask = "__/__/____"
    'pour ceux qui n'ont pas le pavé numerique conversion du keycode du pavé haut du clavier
    If KeyCode >= 48 And KeyCode <= 57 Then KeyCode = KeyCode + 48
    'c'est parti on démarre le controle!!
    With TxtB
        Xl = .SelLength: If Xl = 0 Then Xl = 1    'Xl= la longeur de texte selectionné
        .Value = IIf(.Value = "", mask, .Value): If KeyCode = 8 And Xl > 1 Then KeyCode = 46
        T = .Value: .SelStart = IIf(T = mask, 0, .SelStart): X = .SelStart:
        Select Case KeyCode
        Case 96 To 105  'pavé numerique haut et bas (Attention!!!pas besoins de bloquer la touche MAJ!!!!!!!!le code se charge de convertir)
            If X = 10 Then KeyCode = 0: Exit Sub
            If X = 2 Or X = 5 Then X = X + 1
            Mid(T, X + 1, Xl) = Chr(KeyCode - 48) & Mid(mask, X + 2, Xl - 1)
            X = X + 1: Xl = 0: If X = 2 Or X = 5 Then X = X + 1
            'le plus gros tu traitement se passe avec controle de validité de date en fait!!!
            If Val(T) > 12 Or Val(Mid(T, 1, 1)) > 1 Then X = 0: Xl = 2: Mid(T, 1, 2) = Mid(mask, 1, 2): Beep
            If Val(Mid(T, 4, 2)) > 31 Or Val(Mid(T, 4, 1)) > 3 Then Mid(T, 4.2) = Mid(mask, 4, 2): X = 3: Xl = 2: Beep
            D = Mid(T, 4, 2): M = Mid(T, 1, 2): A = Mid(T, 7, 4)
            If IsDate(D & "/" & M) And Not IsDate(D & "/" & M & "/2000") Then Mid(T, 4, 2) = Mid(mask, 4, 2): X = 3: Xl = 2: Beep: KeyCode = 0
            If X = 10 And Not IsDate(T) Then Mid(T, 7, 10) = Mid(mask, 7, 10): X = 6: Xl = 4: Beep

        Case 8:
            If X = 0 Then KeyCode = 0:: .Value = "": Exit Sub Else Mid(T, X, 1) = Mid(mask, X, 1): X = X - 1: Xl = 0
            If T = mask Then T = ""
        Case 46:
            If X = 10 Then Exit Sub Else Mid(T, X + 1, Xl) = Mid(mask, X + 1, Xl): X = X: Xl = 0: If X = 2 Or X = 5 Then X = X + 1
            If T = mask Then T = ""
        Case Else: KeyCode = 0    ' a pour effet d'inhiber toutes les autre touches
        End Select
        .Value = T 'restitution
        .SelStart = X: .SelLength = Xl: KeyCode = 0
    End With
End Sub

N° Securité social format "x xx xx xx xxx xxx xx"

'********************************************************************
'COLLECTION TEXTBOX FORMATE EPISODE 1 EXERCICE 1                    *
'         UN SecuBox avec masque de saisie                          *
'en version simplifié a but école                                   *
'auteur patricktoulon sur exceldownload et excel pratique           *
'version 3.7                                                        *
'                                                                   *
'le moteur séparé de l'event pour utilisation multi textbox         *
'********************************************************************
Option Explicit
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    CtrL_Secu TextBox1, KeyCode
End Sub

Private Sub CtrL_Secu(ByVal TxtB As MSForms.TextBox, ByVal KeyCode As MSForms.ReturnInteger)
    Dim X&, Xl&, T$, mask$
    mask = "_ __ __ __ ___ ___ __"

    'pour ceux qui n'ont pas le pavé numerique conversion du keycode du pavé haut du clavier(Attention!!!pas besoins de bloquer la touche MAJ!!!!!!!!le code se charge de convertir)
    If KeyCode >= 48 And KeyCode <= 57 Then KeyCode = KeyCode + 48

    'c'est parti on démarre le controle!!
    With TxtB
        Xl = .SelLength: If Xl = 0 Then Xl = 1    'Xl= la longeur de texte selectionné
        .Value = IIf(.Value = "", mask, .Value): If KeyCode = 8 And Xl > 1 Then KeyCode = 46
        T = .Value: .SelStart = IIf(T = mask, 0, .SelStart): X = .SelStart:

        Select Case KeyCode
        Case 96 To 105  'pavé numerique haut et bas
            If X = 21 Then KeyCode = 0: Exit Sub
            If X = 1 Or X = 4 Or X = 7 Or X = 10 Or X = 14 Or X = 18 Then X = X + 1
            Mid(T, X + 1, Xl) = Chr(KeyCode - 48) & Mid(mask, X + 2, Xl - 1): X = X + 1: Xl = 0:
            If X = 1 Or X = 4 Or X = 7 Or X = 10 Or X = 14 Or X = 18 Then X = X + 1
        Case 8:
            If X = 0 Then KeyCode = 0:: .Value = "": Exit Sub
            Mid(T, X, 1) = Mid(mask, X, 1): X = X - 1: Xl = 0: If T = mask Then T = ""
        Case 46:
            If X = 21 Then KeyCode = 0: Exit Sub
            Mid(T, X + 1, Xl) = Mid(mask, X + 1, Xl): X = X: Xl = 0: If T = mask Then T = ""
        Case Else: KeyCode = 0    ' a pour effet d'inhiber toutes les autre touches
        End Select
        .Value = T    'restitution
        .SelStart = X: .SelLength = Xl
        KeyCode = 0
    End With
End Sub

N° téléphone format "xx xx xx xx xx"

'********************************************************************
'COLLECTION TEXTBOX FORMATE EPISODE 1 EXERCICE 1                    *
'         UN phonnebox FR avec masque de saisie                     *
'en version simplifié a but école                                   *
'auteur patricktoulon sur exceldownload et excel pratique           *
'version 3.7                                                        *
'                                                                   *
'le moteur séparé de l'event pour utilisation multi textbox         *
'********************************************************************
Option Explicit
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim X&, Xl&, D&, M&, A, T$, mask: mask = "__ __ __ __ __"
    'pour ceux qui n'ont pas le pavé numerique conversion du keycode du pavé haut du clavier(Attention!!!pas besoins de bloquer la touche MAJ!!!!!!!!le code se charge de convertir)
    If KeyCode >= 48 And KeyCode <= 57 Then KeyCode = KeyCode + 48
    'c'est parti on démarre le controle!!
    With TextBox1
        Xl = .SelLength: If Xl = 0 Then Xl = 1    'Xl= la longeur de texte selectionné
        .Value = IIf(.Value = "", mask, .Value): If KeyCode = 8 And Xl > 1 Then KeyCode = 46
        T = .Value: .SelStart = IIf(T = mask, 0, .SelStart): X = .SelStart:
        Select Case KeyCode
        Case 96 To 105  'pavé numerique haut et bas
            If X = 14 Then KeyCode = 0: Exit Sub
            If X = 2 Or X = 5 Or X = 8 Or X = 11 Then X = X + 1
            Mid(T, X + 1, Xl) = Chr(KeyCode - 48) & Mid(mask, X + 2, Xl - 1)
            X = X + 1: Xl = 0: If X = 2 Or X = 5 Or X = 8 Or X = 11 Then X = X + 1
            KeyCode = 0
        Case 8:
            If X = 0 Then KeyCode = 0:: .Value = "": Exit Sub
            Mid(T, X, 1) = Mid(mask, X, 1): X = X - 1: Xl = 0: If T = mask Then T = ""
            KeyCode = 0    ' on annule toujours la touche
        Case 46:
            If X = 14 Then KeyCode = 0: Exit Sub
            Mid(T, X + 1, Xl) = Mid(mask, X + 1, Xl): X = X: Xl = Xl - 1: If T = mask Then T = ""
            KeyCode = 0    ' on annule toujours la touche
        Case Else
            KeyCode = 0
        End Select
        .Value = T 'restitution
        .SelStart = X: .SelLength = Xl
        KeyCode = 0
    End With
End Sub

Ibanbox Fr format ""FR_-____-____-____-____-____-___"

'********************************************************************
'COLLECTION TEXTBOX FORMATE EPISODE 1 EXERCICE 1                    *
'         UN Ibanbox avec masque de saisie                          *
'en version simplifié a but école                                   *
'auteur patricktoulon sur exceldownload et excel pratique           *
'version 3.7                                                        *
'                                                                   *
'le moteur séparé de l'event pour utilisation multi textbox         *
'********************************************************************
Option Explicit
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
CTRL_IbanFR TextBox1, KeyCode
End Sub

Private Sub CTRL_IbanFR(ByVal TxtB As MSForms.TextBox, ByVal KeyCode As MSForms.ReturnInteger)
    Dim X&, Xl&, D&, M&, A, T$, mask: mask = "FR_-____-____-____-____-____-___"
    'pour ceux qui n'ont pas le pavé numerique conversion du keycode du pavé haut du clavier(Attention!!!pas besoins de bloquer la touche MAJ!!!!!!!!le code se charge de convertir)
    If KeyCode >= 48 And KeyCode <= 57 Then KeyCode = KeyCode + 48
    'c'est parti on démarre le controle!!
    With TxtB
        Xl = .SelLength: If Xl = 0 Then Xl = 1    'Xl= la longeur de texte selectionné
        .Value = IIf(.Value = "", mask, .Value):
        T = .Value: .SelStart = IIf(T = mask, 2, .SelStart): X = .SelStart: If KeyCode = 8 And Xl > 1 Then KeyCode = 46
        Select Case KeyCode
        Case 96 To 105  'pavé numerique haut et bas
            If X = 32 Then KeyCode = 0: Exit Sub
            If X = 3 Or X = 8 Or X = 13 Or X = 18 Or X = 23 Or X = 28 Or X = 35 Then X = X + 1
            Mid(T, X + 1, Xl) = Chr(KeyCode - 48) & Mid(mask, X + 2, Xl - 1)
            X = X + 1: Xl = 0:  If X = 3 Or X = 8 Or X = 13 Or X = 18 Or X = 23 Or X = 28 Or X = 35 Then X = X + 1

            Case 8:
            If X = 2 Then KeyCode = 0:: .Value = "": Exit Sub
            Mid(T, X, 1) = Mid(mask, X, 1): X = X - 1: Xl = 0: If T = mask Then T = ""

          Case 46:
            If X = 32 Then KeyCode = 0: Exit Sub
            Mid(T, X + 1, Xl) = Mid(mask, X + 1, Xl): X = X: Xl = Xl - 1: If T = mask Then T = ""

         Case Else ' a pour effet d'inhiber toutes les autre touches
            KeyCode = 0
        End Select
        .Value = T 'restitution
        .SelStart = X: .SelLength = Xl
        KeyCode = 0
    End With
End Sub

refBox exemple avec parties fixes inmodifiables

'********************************************************************
'COLLECTION TEXTBOX FORMATE EPISODE 1 EXERCICE 1                    *
'         UN style reference avec masque de saisie                  *
' avec partie fixe inmodifiable                                     *
'en version simplifié a but école                                   *
'auteur patricktoulon sur exceldownload et excel pratique           *
'version 3.7                                                        *
'                                                                   *
'le moteur séparé de l'event pour utilisation multi textbox         *
'********************************************************************

Option Explicit
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
CtrL_REF1 TextBox1, KeyCode
End Sub

Private Sub CtrL_REF1(ByVal TxtB As MSForms.TextBox, ByVal KeyCode As MSForms.ReturnInteger)
    Dim X&, Xl&, D&, M&, A, T$, mask: mask = "REF/____-__-GAFX:_____"
    'pour ceux qui n'ont pas le pavé numerique conversion du keycode du pavé haut du clavier(Attention!!!pas besoins de bloquer la touche MAJ!!!!!!!!le code se charge de convertir)
    If KeyCode >= 48 And KeyCode <= 57 Then KeyCode = KeyCode + 48
    'c'est parti on démarre le controle!!
    With TxtB
        Xl = .SelLength: If Xl = 0 Then Xl = 1    'Xl= la longeur de texte selectionné
        .Value = IIf(.Value = "", mask, .Value):
        T = .Value: .SelStart = IIf(T = mask, 4, .SelStart): X = .SelStart: If KeyCode = 8 And Xl > 1 Then KeyCode = 46
        Select Case KeyCode
        Case 96 To 105  'pavé numerique haut et bas
            If X = Len(mask) Then KeyCode = 0: Exit Sub
            Select Case X: Case 8: X = X + 1: Case 11, 12, 13, 14, 15, 16: X = 17: End Select
            Mid(T, X + 1, Xl) = Chr(KeyCode - 48) & Mid(mask, X + 2, Xl - 1)
            X = X + 1: Xl = 0:
            Select Case X: Case 8: X = X + 1: Case 11, 12, 13, 14, 15, 16: X = 17: End Select

        Case 8:
            If X = 2 Then KeyCode = 0: .Value = "": Exit Sub
            Mid(T, X, 1) = Mid(mask, X, 1): X = X - 1: Xl = 0: If T = mask Then T = ""

        Case 46:
            If X = 32 Then KeyCode = 0: Exit Sub
            Mid(T, X + 1, Xl) = Mid(mask, X + 1, Xl): X = X: Xl = Xl - 1: If T = mask Then T = ""

        Case Else    ' a pour effet d'inhiber toutes les autre touches
            KeyCode = 0
        End Select
        .Value = T    'restitution
        .SelStart = X: .SelLength = Xl
        KeyCode = 0
    End With
End Sub

Allez j'en rajoute

prendre un userform et lui mettre 3 textbox ( les noms laissez les d'origine)

3 textbox et un events unique (classe de control intra userform)

'********************************************************************
'COLLECTION TEXTBOX FORMATE EPISODE 1 EXERCICE 1                    *
'des  DATEBOX avec masque de saisformat FR                          *
'en version simplifié a but école                                   *
'auteur patricktoulon sur exceldownload et excel pratique           *
'version 3.7                                                        *
'                                                                   *
'le moteur séparé de l'event pour utilisation multi textbox         *
'!!!classement des textbox intra userform (sans module classe)!!!   *
'********************************************************************
Option Explicit
Public WithEvents TxT As MSForms.TextBox
Dim cls(1 To 3) As New ufclassetextbox 'tableau instance de classe

Private Sub UserForm_Activate()
    Dim i&
    For i = 1 To 3
        Set cls(i).TxT = Me.Controls("TextBox" & i)
    Next
End Sub

'!!!!!!!!!!!!!!!!!!!!!!!un seul event pour tout les textboxs!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Private Sub TxT_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    CtrL_KeyDown TxT, KeyCode
End Sub

Private Sub CtrL_KeyDown(ByVal TxtB As MSForms.TextBox, ByVal KeyCode As MSForms.ReturnInteger)
    Dim X&, Xl&, D$, M$, A, T$, mask, C2, D2: mask = "__/__/____"
    'pour ceux qui n'ont pas le pavé numerique conversion du keycode du pavé haut du clavier
    If KeyCode >= 48 And KeyCode <= 57 Then KeyCode = KeyCode + 48
    'c'est parti on démarre le controle!!
    With TxtB
        Xl = .SelLength: If Xl = 0 Then Xl = 1    'Xl= la longeur de texte selectionné
        .Value = IIf(.Value = "", mask, .Value): If KeyCode = 8 And Xl > 1 Then KeyCode = 46
        T = .Value: .SelStart = IIf(T = mask, 0, .SelStart): X = .SelStart:
        Select Case KeyCode
        Case 96 To 105  'pavé numerique haut et bas (Attention!!!pas besoins de bloquer la touche MAJ!!!!!!!!le code se charge de convertir)
            If X = 10 Then KeyCode = 0: Exit Sub
            If X = 2 Or X = 5 Then X = X + 1
            Mid(T, X + 1, Xl) = Chr(KeyCode - 48) & Mid(mask, X + 2, Xl - 1)
            X = X + 1: Xl = 0: If X = 2 Or X = 5 Then X = X + 1
            'le plus gros tu traitement se passe avec controle de validité de date en fait!!!
            If Val(T) > 31 Or Val(Mid(T, 1, 1)) > 3 Then X = 0: Xl = 2: Mid(T, 1, 2) = Mid(mask, 1, 2): Beep
            If Val(Mid(T, 4, 2)) > 12 Or Val(Mid(T, 4, 1)) > 1 Then Mid(T, 4.2) = Mid(mask, 4, 2): X = 3: Xl = 2: Beep
            D = Mid(T, 1, 2): M = Mid(T, 4, 2): A = Mid(T, 7, 4)
            If IsDate(D & "/" & M) And Not IsDate(D & "/" & M & "/2000") Then Mid(T, 4, 2) = Mid(mask, 4, 2): X = 3: Xl = 2: Beep: KeyCode = 0
            If X = 10 And Not IsDate(T) Then Mid(T, 7, 10) = Mid(mask, 7, 10): X = 6: Xl = 4: Beep

        Case 8:
            If X = 0 Then KeyCode = 0:: .Value = "": Exit Sub Else Mid(T, X, 1) = Mid(mask, X, 1): X = X - 1: Xl = 0
            If T = mask Then T = ""
        Case 46:
            If X = 10 Then Exit Sub Else Mid(T, X + 1, Xl) = Mid(mask, X + 1, Xl): X = X: Xl = 0: If X = 2 Or X = 5 Then X = X + 1
            If T = mask Then T = ""
        Case Else: KeyCode = 0    ' a pour effet d'inhiber toutes les autre touches
        End Select
        .Value = T    'restitution
        .SelStart = X: .SelLength = Xl: KeyCode = 0
    End With
End Sub


allez on en rajoute une couche

le modele plu-ri format

ici c'est a peine un peu différent le masque de saisie sera dynamique et injecté par l'appel (6 textboxs, 6 formats différents, une seul fonction )

'********************************************************************
'COLLECTION TEXTBOX FORMATE EPISODE 1 EXERCICE 1                    *
'         UN textbox  avec masque de saisie                         *
'la fonction est multi format                                       *
'en version simplifié a but école                                   *
'auteur patricktoulon sur exceldownload et excel pratique           *
'version 3.7                                                        *
'                                                                   *
'le moteur séparé de l'event pour utilisation multi textbox         *
'********************************************************************
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    CtrL_Keydown TextBox1, KeyCode, "__/__/____", True 'uniquement date FR
End Sub

Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    CtrL_Keydown TextBox2, KeyCode, "__ __ __ __ __" 'téléphone
End Sub

Private Sub TextBox3_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    CtrL_Keydown TextBox3, KeyCode, "ref:____/____" ' style ref avec prefixe inmodifiable
End Sub

Private Sub TextBox4_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    CtrL_Keydown TextBox4, KeyCode, "_ __ __ __ ___ ___ __" ' securité sociale
End Sub

Private Sub TextBox5_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    CtrL_Keydown TextBox5, KeyCode, "FR_-____-____-____-____-____-___" ' Iban FR
End Sub

Private Sub TextBox6_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    CtrL_Keydown TextBox6, KeyCode, "ref:____:/OFF:__ ___" ' préfixe,sufixe ,x separateurs diférents
End Sub

Sub CtrL_Keydown(ByVal TxtB As MSForms.TextBox, ByVal KeyCode As MSForms.ReturnInteger, ByVal mask As String, Optional dat As Boolean)
    If KeyCode >= 48 And KeyCode <= 57 Then KeyCode = KeyCode + 48
    With TxtB
        Xl = .SelLength: If Xl = 0 Then Xl = 1    'Xl= la longeur de texte selectionné
        .Value = IIf(.Value = "", mask, .Value): If KeyCode = 8 And Xl > 1 Then KeyCode = 46
        T = .Value: .SelStart = IIf(T = mask, InStr(1, mask, "_") - 1, .SelStart): X = .SelStart:
        Select Case KeyCode
        Case 96 To 105  'pavé numerique haut et bas (Attention!!!pas besoins de bloquer la touche MAJ!!!!!!!!le code se charge de convertir)
            If dat Then Xl = 2
            If X = Len(mask) Then KeyCode = 0: Exit Sub
            If Mid(T, X + 1, 1) <> "_" And Not Mid(T, X + 1, 1) Like "[0-9]" Then X = InStr(T, "_") - 1
            Mid(T, X + 1, Xl) = Chr(KeyCode - 48) & Mid(mask, X + 2, Xl - 1): Xl = 0
            X = IIf(Mid(T, X + 1, 1) <> "_", InStr(T, "_") - 1, X + 1)
            If dat Then
                If Val(T) > 31 Or Val(Mid(T, 1, 1)) > 3 Then X = 0: Xl = 2: Mid(T, 1, 2) = Mid(mask, 1, 2): Beep
                If Val(Mid(T, 4, 2)) > 12 Or Val(Mid(T, 4, 1)) > 1 Then Mid(T, 4.2) = Mid(mask, 4, 2): X = 3: Xl = 2: Beep
                D = Mid(T, 1, 2): M = Mid(T, 4, 2): A = Mid(T, 7, 4)
                If IsDate(D & "/" & M) And Not IsDate(D & "/" & M & "/2000") Then Mid(T, 4, 2) = Mid(mask, 4, 2): X = 3: Xl = 2: Beep: KeyCode = 0
                If InStr(1, T, "_") = 0 And Not IsDate(T) Then Mid(T, 7, 10) = Mid(mask, 7, 10): X = 6: Xl = 4: Beep  End If
        Case 8:
            If X = 0 Then KeyCode = 0:: .Value = "": Exit Sub Else Mid(T, X, 1) = Mid(mask, X, 1): X = X - 1: Xl = 0
            If T = mask Then T = ""
        Case 46:
            If X = 10 Then Exit Sub Else Mid(T, X + 1, Xl) = Mid(mask, X + 1, Xl): X = X: Xl = 0: 'If X = 2 Or X = 5 Then X = X + 1
            If T = mask Then T = ""
        Case Else: KeyCode = 0    ' a pour effet d'inhiber toutes les autre touches
        End Select
        .Value = T    'restitution
        If X > Len(mask) Or X = -1 Then X = Len(mask)
        .SelStart = X: .SelLength = 0: KeyCode = 0
    End With
    KeyCode = 0
End Sub


Merci Patrick !

de rien Baboutz

la suite au prochain épisode (masque dynamique) juste pour le fun

mais je l'adapte d'abords en version simplifié sinon c'est la rupture d’anévrisme

Bonjour a tous

aujourd'hui j'en rajoute un

le textbox avec suffixe automatique (€,%,"Km",et tout autre suffixe que vous voulez )

Sub Txt_Suffixe(TxtB As MSForms.TextBox, ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer, Optional ByVal suffixe As String = "")
    Dim S&, St&
    With TxtB
        S = .SelLength
        St = .SelStart
        '-----------------------------------------------
        'en cas de reprise avec selection de chaine
        x = Replace(.Value, " " & suffixe, "")
        If .SelStart < Len(x) Then
            If Mid(x, St + 1, 1) Like "[.,]" Then St = St + 1
            If Not IsNumeric(Chr(KeyCode - 48)) Then KeyCode = 0: Exit Sub
            Mid(x, St + 1, 1) = Chr(KeyCode - 48): KeyCode = 0
            .Value = x
            If .Value <> "" Then
                If S >= 1 Then
                    .Value = .Value & " " & suffixe
                    .SelStart = St + 1
                    .SelLength = S - 1
                    If Trim(Mid(.Value, St + 2, 10)) = suffixe Then .SelLength = 0
                    Exit Sub
                Else
                    .Value = .Value & " " & suffixe
                    .SelStart = Len(x)
                    Exit Sub
                End If
            End If
        End If
        '------------------------------------------------------------
        Select Case KeyCode
        Case 96 To 105
            If x <> "" Then If Len(Replace(x, Val(Int(x)), "")) >= 3 Then KeyCode = 0: Exit Sub
            x = x & Chr(KeyCode + IIf(KeyCode < 96, 32, -48))
        Case 110, 188: If Not x Like "*,*" Then x = x & ","
        Case 8: x = Left(x, Len(x) - IIf(x <> "", 1, 0))
        Case Else: KeyCode = 0
        End Select
        .Value = x
        If .Value <> "" Then .Value = .Value & " " & suffixe
        .SelStart = Len(x)
    End With
    KeyCode = 0
End Sub
'les suffixes peuvent etre toute unité de mesure(€,%,"Km","cm",etc...)
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Txt_Suffixe TextBox1, KeyCode, 0, suffixe:="€"
End Sub

Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Txt_Suffixe TextBox2, KeyCode, 0, suffixe:="%"
End Sub

Private Sub TextBox3_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Txt_Suffixe TextBox3, KeyCode, 0, suffixe:="Km"
End Sub

Merci beaucoup! c'est exactement ce que je cherchais !

Bonjour a tous, Bonjour PATRICKTOULON

le dernier

Sub Txt_Suffixe

est sublime!!!

une demande un peu exagéré de ma part!! n'y a t il pas le même code avec partage de millier???

merci d'avance

Bonjour,

Mention spéciale déterrage de topic...

@iliyes :

n'y a t il pas le même code avec partage de millier?

Private Sub TextBox1_Change()
  TextBox1.Text = Format(TextBox1.Text, "#,##0")
End Sub

bonjour à tous

Merci @pijaku

très belle journée

Rechercher des sujets similaires à "collection textbox formates masque saisie"