Option Explicit
Public 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
sp = Left(Replace(flt, "#", ""), 1)
drf = "31" & sp & "12" & sp & "2000" 'ne touche jamais rien à cette chaine
With t
ici = .SelStart
If cod = 46 And .SelText = Mid(.Text, ici + 1) Then
.Text = Left(.Text, ici)
If Len(.Text) = 2 Or Len(.Text) = 5 Then .Text = Left(.Text, Len(.Text) - 1)
cod = 0: Exit Sub
End If
If ici < Len(.Text) Then .SelStart = Len(.Text): cod = 0: Exit Sub
If cod = 8 Then
If ici = 3 Or ici = 6 Then .Text = Left(.Text, Len(.Text) - 1)
Exit Sub
End If
If cod = 37 And ici = 0 Then
If IsDate(.Tag) Then .Text = .Tag: cod = 0: 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 cod = 32 Then
If ici = 0 Or ici = 3 Or ici = 6 Or ici = 8 Then
Dim voir As String
voir = .Text & Mid(Format(Date, "dd" & sp & "mm" & sp & "yyyy"), ici + 1)
If IsDate(voir) Then .Text = voir
End If
cod = 0: Exit Sub
End If
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
Public Sub alarme(f As UserForm, t As MSForms.TextBox, ByRef c As MSForms.ReturnBoolean)
Dim debut As Double, Msg_date As String
If t.Text <> "" And Len(t.Text) < 10 Then
c = True
With f.Msg_date
.Move t.Left - 20, t.Top - 10, t.Width + 40, 60
.ZOrder
.Font.Name = "MS Sans Serif"
.Font.Bold = True
.Font.Size = 9
.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
Else
If t.Text <> "" Then t.Tag = t.Text
End If
End Sub
Option Explicit
Private Sub CommandButton1_Click()
' juste pour tout effacer toutes tes textboxes et tester
Dim i As Byte
For i = 1 To 3
Me.Controls("T_date" & i).Text = ""
Next
End Sub
Private Sub T_date1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
alarme Me, ActiveControl, Cancel
End Sub
Private Sub T_date1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
teste_date ActiveControl, KeyCode, "##/##/####", True
End Sub
Private Sub T_date2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
alarme Me, ActiveControl, Cancel
End Sub
Private Sub T_date2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
teste_date ActiveControl, KeyCode, "## ## ####", False
End Sub
Private Sub T_date3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
alarme Me, ActiveControl, Cancel
End Sub
Private Sub T_date3_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
teste_date ActiveControl, KeyCode, "##-##-####", False
End Sub
MsgBox IsDate(TextBox1.Value) And Split(TextBox1.Text, "/")(1) <= 12 And TextBox1.Text Like "##/##/####"
MsgBox IsDate(TextBox1.Value) And TextBox1.Text Like "##/##/####" And Val(Mid(TextBox1.Text, 4, 2)) < 13
Msgbox isdate(textbox1.value)===>> True si date , false sinon
MsgBox IsDate(TextBox1.Value) And Split(TextBox1.Text, "/")(1) <= 12
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionIf IsDate(date_depense.Value) And date_depense.Text Like "##/##/####" And Val(Mid(date_depense.Text, 4, 2)) < 13 Then
MsgBox "date valide" '====>> remplace par tes instructions ou rien
Else
MsgBox "date non valide" '====>>> remplace par tes instructions (par exemple : message et retour sur la textbox
End If
Private Sub depense.Text_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If depense.Text.Text = "" Then Exit Sub ' supprime cette ligne si tu veux obliger à saisir, en plus
If IsDate(depense.Text.Value) And depense.Text.Text Like "##/##/####" And Val(Mid(depense.Text.Text, 4, 2)) < 13 Then Exit Sub
MsgBox "la date doit être valide et à saisir obligatoirement sous la forme jj/mm/aaaa"
Cancel = True
End Sub
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
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