Bonjour,
Voilà un petit cadeau très matinal pour toi :
Crée un nouvel userform (peu importe, c'est juste pour voir et comprendre)
mets-y une textbox nommée t_date (celle qui va servir à saisir une date)
mets-y où tu veux (le code va le replacer) un label nommé Msg_date invisible (propriété visible = false)
mets-y un ou deux autres contrôles de ton choix (ce que tu veux)
et ce code :
Option Explicit
Private Sub T_date_Exit(ByVal Cancel As MSForms.ReturnBoolean)
alarme ActiveControl, Cancel
End Sub
Private Sub T_date_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'tu peux aussi (selon ton gôut) utiliser "##/##/####","##-##-####" ou "## ## ####"
teste_date ActiveControl, KeyCode, "##/##/####"
End Sub
'========================================
Private Sub teste_date(ByRef t As MSForms.TextBox, ByRef cod As MSForms.ReturnInteger, ByVal flt As String)
Dim ici As Byte, sp As String, cr As String, drf As String, dtt As String
Application.CutCopyMode = False
sp = Left(Replace(flt, "#", ""), 1)
drf = "31" & sp & "12" & sp & "2000" 'ne touche jamais rien à cette chaine
With t
ici = .SelStart
If ici < Len(.Text) Then
.SelStart = Len(.Text): cod = 0: Exit Sub
End If
If cod = 8 Then
If ici = 3 Or ici = 6 Then .Text = Left(.Text, Len(.Text) - 1)
Exit Sub
End If
If cod > 95 Then cr = Chr(cod - 48)
If ici = 3 Then Mid(drf, 1, 5) = IIf(cr = "0", "00" & sp & "01", "00" & sp & "02")
dtt = .Text & cr & Mid(drf, ici + 2)
If Not IsDate(dtt) Or Not dtt Like flt Then cod = 0: Exit Sub
Select Case ici
Case 1, 4
If ici = 4 And Val(Mid(.Text, ici, 1) & cr) > 12 Then cod = 0: Exit Sub
.Text = Left(dtt, Len(.Text & cr)) & sp: cod = 0
Case 3
If cr > "1" Then cod = 0
End Select
End With
Application.CutCopyMode = True
End Sub
Private Sub alarme(t As MSForms.TextBox, ByRef c As MSForms.ReturnBoolean)
Dim debut As Double
If t.Text <> "" And Len(t.Text) < 10 Then
c = True
With Msg_date
.Move t.Left - 20, t.Top - 20, t.Width + 40, 60
.ZOrder
.Font.Name = "MS Sans Serif"
.Font.Bold = True
.Font.Size = 10
.Caption = "la date doit être sous la forme jj/mm/aaaa avec un millésime sur 4 chiffres)"
.BackColor = vbYellow
.ForeColor = vbRed
.TextAlign = fmTextAlignCenter
.Visible = True
debut = Timer
Do While Timer < debut + 4
DoEvents
Loop
.Visible = False
End With
End If
End Sub
Lance et fais joujou avec cela. Tu vas très vite comprendre le confort
Il est clair que les deux procédures après le trait "=========="
sont utilisables pour toute autre textbox additionnelle éventuelle de date à contrôler (en te précisant que tu n'as aucun autre label d'alarme à créer dans ce cas. Le même sert pour tout)
EDIT : attends ... je viens de découvrir un tout petit bug très facile à corriger sur certaines années bissextiles. Je vais le corriger au retour de ma partie de pêche et en profiterai pour y ajouter une touche de confort supplémentaire (ajout d'un paramètre qui, si à True , saisit en plus automatiquement les deux premiers chiffres du millésime en cours)
A +, donc (vers 11 heures)
________________________
Nul ne saurait valablement coder ce qu'il ne saurait exposer clairement.
EDIT 2 :
Tiens (suis en forme, ce matin) ===>> bug déjà corrigé + ajout du petit confort supplémentaire optionnel dont je te parlais.
Option Explicit
Private Sub T_date_Exit(ByVal Cancel As MSForms.ReturnBoolean)
alarme ActiveControl, Cancel
End Sub
Private Sub T_date_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'tu peux aussi (selon ton gôut) utiliser "##/##/####","##-##-####" ou "## ## ####"
teste_date ActiveControl, KeyCode, "##/##/####", True
End Sub
Private Sub teste_date(ByRef t As MSForms.TextBox, ByRef cod As MSForms.ReturnInteger, ByVal flt As String, scl As Boolean)
Dim ici As Byte, sp As String, cr As String, drf As String, dtt As String, siecle As Boolean
'siecle = True
Application.CutCopyMode = False
sp = Left(Replace(flt, "#", ""), 1)
drf = "31" & sp & "12" & sp & "2000" 'ne touche jamais rien à cette chaine
With t
ici = .SelStart
If ici < Len(.Text) Then
.SelStart = Len(.Text): cod = 0: Exit Sub
End If
If cod = 8 Then
If ici = 3 Or ici = 6 Then .Text = Left(.Text, Len(.Text) - 1)
Exit Sub
End If
If cod > 95 Then cr = Chr(cod - 48)
If ici = 3 Then Mid(drf, 1, 5) = IIf(cr = "0", "00" & sp & "01", "00" & sp & "02")
dtt = .Text & cr & Mid(drf, ici + 2)
If ici <> 8 Then
If Not IsDate(dtt) Or Not dtt Like flt Then cod = 0: Exit Sub
Else
If Not IsNumeric(cr) Then cod = 0: Exit Sub
End If
Select Case ici
Case 1, 4
If ici = 4 And Val(Mid(.Text, ici, 1) & cr) > 12 Then cod = 0: Exit Sub
If ici = 4 And scl Then
.Text = Left(dtt, Len(.Text & cr)) & sp & Int(Year(Date) / 100): cod = 0
Else
.Text = Left(dtt, Len(.Text & cr)) & sp: cod = 0
End If
Case 3
If cr > "1" Then cod = 0
End Select
End With
Application.CutCopyMode = True
End Sub
Private Sub alarme(t As MSForms.TextBox, ByRef c As MSForms.ReturnBoolean)
Dim debut As Double
If t.Text <> "" And Len(t.Text) < 10 Then
c = True
With Msg_date
.Move t.Left - 20, t.Top - 20, t.Width + 40, 60
.ZOrder
.Font.Name = "MS Sans Serif"
.Font.Bold = True
.Font.Size = 10
.Caption = "la date doit être sous la forme jj/mm/aaaa avec un millésime sur 4 chiffres)"
.BackColor = vbYellow
.ForeColor = vbRed
.TextAlign = fmTextAlignCenter
.Visible = True
debut = Timer
Do While Timer < debut + 4
DoEvents
Loop
.Visible = False
End With
End If
End Sub
Regarde la différence en appelant avec True ou avec False dans
teste_date ActiveControl, KeyCode, "##/##/####", True
tu vas vite comprendre.