patricktoulon
XLDnaute Barbatruc
Bonjours a tous
je vous propose ce petit code pour transformer un textbox en Datebox
il faut seulement que le texte"__/__/____" soit présent dans le textbox
seules les touches du pavé numérique ,back et suppr sont acceptées
vous tapez si a un moment la partie tapée n'est pas valide la fonction bloque la sélection sur la partie en faute
vous retapez sans rien toucher ni souris ou touche pour se repositionner
les touche back et suppr font leur boulot initial sauf que le masque de saisie se remet en place
derniere mise a jour 26/06/2018
---------------------------------------------------------------------------------
--------------------------------------------------------------------------------------------------------------------------
je vous propose ce petit code pour transformer un textbox en Datebox
il faut seulement que le texte"__/__/____" soit présent dans le textbox
seules les touches du pavé numérique ,back et suppr sont acceptées
vous tapez si a un moment la partie tapée n'est pas valide la fonction bloque la sélection sur la partie en faute
vous retapez sans rien toucher ni souris ou touche pour se repositionner
les touche back et suppr font leur boulot initial sauf que le masque de saisie se remet en place
derniere mise a jour 26/06/2018
---------------------------------------------------------------------------------
Code:
Option Explicit
Private Sub control_saisie(ByRef txt As Object, KeyCode)
Dim T$, X&, Z&, i&
With txt
T = Mid(.Text, 1, 10): X = .SelStart
Select Case KeyCode
Case 8
KeyCode = 0
If .SelLength > 0 Then Exit Sub
If X = 0 Then X = 1:
If Mid(T, X, 1) <> "/" Then Mid(T, X, 1) = "_" Else Mid(T, X, 1) = "/":
.Text = T: .SelStart = X - IIf(X > 0, 1, 0)
Case 46
KeyCode = 0
If .SelLength > 0 Then For i = X To X + .SelLength - 1: Mid(T, i + 1, 1) = IIf(Mid(T, i + 1, 1) <> "/", "_", "/"): Next: .Text = T: .SelStart = X: KeyCode = 0: Exit Sub
If X < 10 And Mid(T, X + 1, 1) <> "/" Then Mid(T, X + 1, 1) = "_": .Text = T: .SelStart = X + 1 Else .SelStart = X + 1
Case 96 To 105, 48 To 57
If .SelLength > 0 Then
Mid(T, X + 1, .SelLength) = Chr(KeyCode - IIf(KeyCode < 96, 0, 48)) & Left("____", .SelLength - 1): .Text = T: .SelStart = X + 1: KeyCode = 0
Else
Z = InStr(1, T, "_"): If Z = 0 Then KeyCode = 0: Exit Sub
Mid(T, Z, 1) = Chr(KeyCode - IIf(KeyCode < 96, 0, 48)): .Text = T: KeyCode = 0: .SelStart = IIf(Mid(T, Z + 1, 1) = "/", Z + 1, Z)
End If
If Val(Mid(T, 1, 1)) > 3 Then Mid(T, 1, 2) = "__": .Text = T: .SelStart = 0: '.SelLength = 2
If Val(Mid(T, 4, 1)) > 3 Then Mid(T, 4, 2) = "__": .Text = T: .SelStart = 3: '.SelLength = 2
If Val(Mid(T, 1, 2)) > 31 Then Mid(T, 1, 2) = "__": .Text = T: .SelStart = 0: '.SelLength = 2
If Val(Mid(T, 1, 2)) > 12 And Val(Mid(T, 4, 1)) > 1 Then Mid(T, 4, 2) = "__": .Text = T: .SelStart = 3: '.SelLength = 2
If Not Mid(T, 1, 6) Like "*_*" And Not IsDate(Mid(T, 1, 6) & "2000") Then Mid(T, 4, 2) = "__": .Text = T: .SelStart = 3: '.SelLength = 2 ' Else '.SelStart = InStr(1, T, "_")
If Not T Like "*_*" Then
If Not IsDate(T) Then Mid(T, 7, 4) = "____": .Text = T: .SelStart = 6: Exit Sub ' .SelLength = 1
If Val(Year(T)) <> Val(Mid(T, 7, 4)) Then Mid(T, 7, 4) = "____": .Text = T: .SelStart = 6:
End If
Case Else: KeyCode = 0: Exit Sub
End Select
End With
End Sub
'
'
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
control_saisie TextBox1, KeyCode
End SubPièces jointes
Dernière édition:
