Private Sub PremièreParution_Change()
' Réinitialise le formulaire pour bouclage et parution
DateBouclage = ""
Ajustement = 0
' Masque de saisie pour la date
Dim Longueur As Integer
Longueur = Len(PremièreParution)
Message = "Saisie incorrecte !"
If Longueur = 8 Then
Dim VérificationValidité As Boolean
VérificationValidité = DateValide(PremièreParution)
If VérificationValidité = False Then GoTo DateInvalide
If CDate(PremièreParution) <= Now Then GoTo DateInvalide
End If
Select Case Longueur
Case 1
If Chiffre(PremièreParution) = True Then
DateBouclage = ""
DateBouclage.ForeColor = RGB(0, 0, 0)
DateBouclage.Font.Bold = False
DateBouclage.BackColor = RGB(255, 255, 255)
Ajustement = 0
Parution = ""
Exit Sub
Else
Msg = MsgBox(Message, vbCritical, "ATTENTION !")
PremièreParution = ""
Exit Sub
End If
Case 2
If Chiffre(Mid(PremièreParution, 2, 1)) = True Then
PremièreParution = PremièreParution & "/"
Exit Sub
Else
Msg = MsgBox(Message, vbCritical, "ATTENTION !")
PremièreParution = Mid(PremièreParution, 2, 1)
Exit Sub
End If
Case 4
If Chiffre(Mid(PremièreParution, 4, 1)) = True Then
Exit Sub
Else
Msg = MsgBox(Message, vbCritical, "ATTENTION !")
PremièreParution = Mid(PremièreParution, 3, 1)
Exit Sub
End If
Case 5
If Chiffre(Mid(PremièreParution, 5, 1)) = True Then
PremièreParution = PremièreParution & "/"
Exit Sub
Else
Msg = MsgBox(Message, vbCritical, "ATTENTION !")
PremièreParution = Mid(PremièreParution, 4, 1)
Exit Sub
End If
Case 7
If Chiffre(Mid(PremièreParution, 7, 1)) = True Then
Exit Sub
Else
Msg = MsgBox(Message, vbCritical, "ATTENTION !")
PremièreParution = Mid(PremièreParution, 6, 1)
Exit Sub
End If
Case 8
If Chiffre(Mid(PremièreParution, 8, 1)) = True Then
DatePremièreParution = PremièreParution
Exit Sub
Else
Msg = MsgBox(Message, vbCritical, "ATTENTION !")
PremièreParution = Mid(PremièreParution, 7, 1)
Exit Sub
End If
End Select
Exit Sub
DateInvalide:
Msg = MsgBox(Message, vbCritical, "ATTENTION !")
PremièreParution = ""
DateBouclage = ""
End Sub