Sub control_saisieX(txt As Object, KeyCode, Optional Mask As String = "__/__/____", Optional region As Long = 1)
'MsgBox KeyCode
Dim Pos&, T$, X&, XL&, xp&, an, XLL&, Max1&, Max2, separateur, charMask$
separateur = Mid(Mask, 3, 1): charMask = Left(Mask, 1)
Max1 = IIf(region = 1, 31, 12): Max2 = IIf(region = 0, 31, 12)
If KeyCode >= 48 And KeyCode <= 57 Then KeyCode = KeyCode + 48 'conversion du keycode du pavé haut du clavier
With txt
If .Value = "" Then .Value = Mask
T = .Value: .SelStart = IIf(T = Mask, 0, .SelStart): X = .SelStart
XL = .SelLength
Select Case KeyCode
Case 96 To 105 'pavé numerique
Select Case X
Case 0 To 1, 3 To 4, 6 To 9 'en fonction du selstart
XL = IIf(XL = 0, 1, XL)
Mid$(T, X + 1, XL) = Chr(KeyCode - 48) & Mid$(Mask, X + 2, XL): X = X + 1 'placement du caractere
'controle date condensé
If Val(T) > Max1 Or Mid(T, 1, 2) = "00" Then Mid$(T, 1, 2) = Mid$(Mask, 1, 2): X = 0: XLL = 2: Beep 'max 31 pour jour
If Val(Mid(T, 4, 2)) > Max2 Or Mid(T, 4, 2) = "00" Then Mid$(T, 4, 2) = Mid$(Mask, 4, 2): X = 3: XLL = 2: Beep ' max 12 pour le mois
If X > 5 Then xp = 7 Else If X < 4 Then xp = 1 Else xp = 4 'calcul position pour replace by mask
If IsNumeric(Mid(T, 7, 4)) And X > 5 Then an = Mid(T, 7, 4): XL = 5 Else an = "2000": XL = 2 'année permuté
If IsDate(Mid(T, 1, 5)) Then If Not IsDate(Mid(T, 1, 5) & separateur & an) Then Mid(T, xp, XL) = Mid(Mask, xp, XL): Beep: X = InStr(1, T, charMask) - 1: XLL = XL
If Mid(T, 7, 4) = "0000" Then Mid$(T, 7, 4) = Mid$(Mask, 7, 4): X = 6: XLL = 4: Beep
.Value = T: .SelStart = IIf(Mid(Mask, X + 1, 1) = separateur, X + 1, X): If XLL > 0 Then .SelLength = XLL 'mise a jour textbox et positionement carret
Case Else: .SelStart = X + 1: KeyCode = 0
End Select
Case 8: If X > 0 Then Mid(T, X, 1) = Mid(Mask, X, 1): .Value = T: .SelStart = X - 1 'touche back
Case 46: Mid(T, X + 1, .SelLength) = Mid(Mask, X + 1, .SelLength): .Value = T: .SelStart = X 'touche "suppr"
Case 37: .SelStart = Application.Max(.SelStart - 1, 0) 'fleche gauche
Case 39: .SelStart = Application.Min(.SelStart + 1, Len(T)) 'fleche droite
Case Else: KeyCode = 0 'aucune autre touche autorisée
End Select
.Value = IIf(T = Mask, "", T)
.BackColor = Array(RGB(255, 150, 150), vbWhite)(Abs(XLL < 1)) 'si erreur backcolor
End With
KeyCode = 0:
End Sub