Collection textbox formatés(patricktoulon)Un
DateBox avec masque de saisie
Bonjour a tous
je vous propose ma fonction qui transforme un TextBox en Date Box pour les 3 formats
principaux
il vous est impossible de taper une date erronée
la gestion d'erreur re sélectionne le segment de la chaîne tapée qui est une erreur accompagné
d'un beep
vous avez la gestion de la touche Back , Suppr , Fleche Droite , Fleche gauche
le masque de saisie est automatique
je laisse le case 9 et 13 (tab et enter )a votre grès d'utilisation
la fonction dans le userform ou module standard
VB:
Option Explicit
Public Function control_keydown(tdat As Object, KeyCode, Optional
mask As String = "dd/mm/yyyy", Optional charMASK As String = "_")
'MsgBox KeyCode
Dim txt$, X&, plus&, longg&, sep$, mask2$
'construction du masque de saisie(mask2) en fonction de la
chaine de format de date injectée
mask2 = Replace(Replace(Replace(mask, "d", charMASK), "m",
charMASK), "y", charMASK)
sep = Left(Replace(mask2, charMASK, ""), 1) 'determine le
caractere de separation
If tdat = "" Then tdat = mask2 'si textbox vide alors =
mask2
txt = [Link]: If txt = mask2 Then [Link] = 0: tdat
= ""
X = [Link]: longg = [Link]: If longg = 0 Then
longg = 1
If KeyCode = 8 And longg > 1 Then KeyCode = 46
Select Case KeyCode
Case 96 To 105
If X = 10 Then KeyCode = 0: Exit Function
If Mid(mask2, X + 1, 1) = sep Then X = X + 1
Mid(txt, X + 1, longg) = Mid(mask2, X + 1, longg): tdat =
txt: plus = IIf(KeyCode < 96, 32, -48): 'reformate si plus de 1
caractere selectionné
Mid(txt, X + 1, 1) = Chr(KeyCode + plus): tdat = txt:
[Link] = X + 1: KeyCode = 0
If Mid(tdat, X + 2, 1) = sep Then [Link] = X + 2
'control de validité de la date tapée a tout moment
Dim Pos1&, Pos2&, Part1$, Part2$, Part3$, PosX&
Select Case True 'determine les segment
jours/mois/année et les positions selstart SELON le format
injecté
Case Left(mask, 2) = "yy": Part2 = Mid(tdat, 6, 2): Part1
= Mid(tdat, 9, 2): Part3 = Mid(tdat, 1, 4): Pos1 = 8: Pos2 = 5:
PosX = 8
Case Left(mask, 2) = "mm": Part2 = Mid(tdat, 1, 2): Part1
= Mid(tdat, 4, 2): Part3 = Mid(tdat, 7, 4): Pos2 = 0: Pos1 = 3:
PosX = 3
Case Left(mask, 2) = "dd": Part1 = Mid(tdat, 1, 2): Part2
= Mid(tdat, 4, 2): Part3 = Mid(tdat, 7, 4): Pos1 = 0: Pos2 = 3:
PosX = 3
End Select
'on ne peut depasser 31 pour les jours et 12 pour le mois
quelque soit le format
If Val(Part1) > 31 Or Val(Left(Part1, 1)) > 3 Or Part1 =
"00" Then [Link] = Pos1: [Link] = 2: Beep: Exit
Function
If Val(Part2) > 12 Or Val(Left(Part2, 1)) > 1 Or Part2 =
"00" Then [Link] = Pos2: [Link] = 2: Beep: Exit
Function
'quand jour et mois sont rempli on teste avec l'annéee
2000(année bissextile pour fevrier)et 30 ou 31 pour les autres
mois
If IsDate(Part1 & "/" & Part2) Then If Not IsDate(Part1 &
"/" & Part2 & "/2000") Then [Link] = PosX: [Link] =
2: Beep
If Not IsDate(tdat) And InStr(tdat, charMASK) = 0 Then
'si plus de caracteres mask on teste la date complete
[Link] = InStrRev([Link], sep):
[Link] = 4: Beep: Exit Function
Else
'pour pallier a l'erreur de isdate pour les année
inferieur a 100 pour fevrier
If IsDate(tdat) Then If Year(CDate(tdat)) <>
Val(Part3) Then [Link] = InStrRev([Link], sep):
[Link] = 4: Beep
End If
Case 8 'touche BACK (Retour en arrière)
If X <> 0 Then Mid(txt, X, longg + 1) = Mid(mask2, X,
longg + 1)
tdat = txt: [Link] = X - 1: KeyCode = 0
If tdat = mask2 Then tdat = ""
If Mid(txt, X - IIf(X > 1, 1, 0), 1) = sep Then
[Link] = X - 2
Case 46 'touche Suppr(supprimer)
Mid(txt, X + 1, longg) = Mid(mask2, X + 1, longg): KeyCode =
0: tdat = txt: [Link] = X 'touche Suppr
Case 37: [Link] = X - 1 'touche fleche gauche
Case 39: [Link] = X + 1 'touche fleche droite
Case 13 Or 9 ' ce que l'on veux c'est la sortie
Case Else: KeyCode = 0 'touche les autres touches sont
exclues
End Select
End Function
tout les arguments sont optional sauf bien entendu le textbox et keycode
de ce fait par défaut le format sera "dd/mm/yyyy" et le masque sera "__/__/____"
comment on s'en sert ?
apel de la fonction
control_keydown [TextBox] , [KeyCode] , [format de date] , [caractère de masque de saisie]
exemple
Code:
Private Sub TextBox1_KeyDown(ByVal KeyCode As
[Link], ByVal Shift As Integer)
control_keydown TextBox1, KeyCode, "yyyy-mm-dd", "_"
End Sub
Private Sub TextBox2_KeyDown(ByVal KeyCode As
[Link], ByVal Shift As Integer)
control_keydown TextBox2, KeyCode, "mm/dd/yyyy", "_"
End Sub
Private Sub TextBox3_KeyDown(ByVal KeyCode As
[Link], ByVal Shift As Integer)
control_keydown TextBox3, KeyCode, "dd/mm/yyyy", "_"
End Sub
Private Sub TextBox4_KeyDown(ByVal KeyCode As
[Link], ByVal Shift As Integer)
control_keydown TextBox4, KeyCode 'argument omis donc par
defaut"dd/mm/yyyy" mask"__/__/____"
End Sub
Private Sub TextBox5_KeyDown(ByVal KeyCode As
[Link], ByVal Shift As Integer)
control_keydown TextBox5, KeyCode, "dd mm yyyy"
End Sub
Auteur
patricktoulon
