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
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
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 = tdat.Value: If txt = mask2 Then tdat.SelStart = 0: tdat = ""
X = tdat.SelStart: longg = tdat.SelLength: 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: tdat.SelStart = X + 1: KeyCode = 0
If Mid(tdat, X + 2, 1) = sep Then tdat.SelStart = 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 tdat.SelStart = Pos1: tdat.SelLength = 2: Beep: Exit Function
If Val(Part2) > 12 Or Val(Left(Part2, 1)) > 1 Or Part2 = "00" Then tdat.SelStart = Pos2: tdat.SelLength = 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 tdat.SelStart = PosX: tdat.SelLength = 2: Beep
If Not IsDate(tdat) And InStr(tdat, charMASK) = 0 Then 'si plus de caracteres mask on teste la date complete
tdat.SelStart = InStrRev(tdat.Text, sep): tdat.SelLength = 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 tdat.SelStart = InStrRev(tdat.Text, sep): tdat.SelLength = 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: tdat.SelStart = X - 1: KeyCode = 0
If tdat = mask2 Then tdat = ""
If Mid(txt, X - IIf(X > 1, 1, 0), 1) = sep Then tdat.SelStart = X - 2
Case 46 'touche Suppr(supprimer)
Mid(txt, X + 1, longg) = Mid(mask2, X + 1, longg): KeyCode = 0: tdat = txt: tdat.SelStart = X 'touche Suppr
Case 37: tdat.SelStart = X - 1 'touche fleche gauche
Case 39: tdat.SelStart = 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 MSForms.ReturnInteger, ByVal Shift As Integer)
control_keydown TextBox1, KeyCode, "yyyy-mm-dd", "_"
End Sub
Private Sub TextBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
control_keydown TextBox2, KeyCode, "mm/dd/yyyy", "_"
End Sub
Private Sub TextBox3_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
control_keydown TextBox3, KeyCode, "dd/mm/yyyy", "_"
End Sub
Private Sub TextBox4_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, 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 MSForms.ReturnInteger, ByVal Shift As Integer)
control_keydown TextBox5, KeyCode, "dd mm yyyy"
End Sub
- Auteur
- patricktoulon
- Version
- 2.0