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
- Messages
- 1'025
- Excel
- 2016 FR // 365
- Inscrit
- 19/04/2019
- Emploi
- Étudiant en 5e année d'école d'Ingénieur
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