FORMATER UN TEXTBOX POUR LA DATE ET L'HEURE

Public Function Check_DateFormat(m As TextBox) As Integer
' Fonction permettant de vérifier si la date entrée dans un Textbox
' (de la forme jjmmaaaa) a un format valide
' renvoie 0 si le format est valide, 1 sinon

Dim nb As Integer
Dim jr As Integer
Dim ms As Integer
Dim ann As Integer

Check_DateFormat = 0

' l'utilisateur doit renseigner le TextBox de la forme jjmmaaaa
If Len(m) <> 8 Then
  ' sinon on sort
  Check_DateFormat = 1
  Exit Function
End If

jr = Fix(m / 1000000) ' pour obtenir le jour
ms = m - (jr * 1000000)
ms = Fix(ms / 10000) ' pour obtenir le mois
ann = m - (jr * 1000000 + ms * 10000) ' et l'année

' on détermine le nombre de jour dans le mois
Select Case ms
Case 1, 3, 5, 7, 8, 10, 12: nb = 31
Case 2:
' année bissextile ???
If ((ann / 4) - Fix(ann / 4)) = 0 Then nb = 29 Else nb = 28
Case 4, 6, 9, 11: nb = 30
End Select

' on teste si la date est correcte
If ms > 12 Or jr > nb Or ann > Year(Now) Then
  m = ""
  Check_DateFormat = 1
  Exit Function
End If

End Function

Public Function Check_HourFormat(m As TextBox) As Integer
' Fonction permettant de vérifier si l'heure entrée dans un Textbox
' (de la forme hhmm) a un format valide
' renvoie 0 si le format est valide, 1 sinon

Dim hr As Integer
Dim min As Integer

Check_HourFormat = 0

' l'utilisateur doit renseigner le TextBox de la forme hhmm
If Len(m) <> 4 Then
  ' sinon on sort
  Check_HourFormat = 1
  Exit Function
End If

hr = Fix(m / 100)   ' pour obtenir l'heure
min = m - (hr * 100) ' pour obtenir les minutes

' on teste si c'est correct
If hr > 23 Or min > 59 Then
  m = ""
  Check_HourFormat = 1
  Exit Function
End If

End Function

' EXEMPLE pour la date
' ----------
' Pour appeler la fonction et formatter la zone, on utilise l'evt LostFocus
' (ici le controle s'appelle Date hein :) )

Private Sub Date_LostFocus()

If Check_DateFormat(Me.Date) = 1 Then
msg = MsgBox("Le Format de la date n'est pas valide", vbExclamation, "Erreur")
Me.Date = ""
Me.Date.SetFocus
Else
' on formatte
Me.Date = Mid(Me.Date, 1, 2) & "/" & Mid(Me.Date, 3, 2) & "/" & Mid(Me.Date, 5, 4)
End If

End Sub

' EXEMPLE pour l'heure
' ----------

Private Sub Heure_LostFocus()

If Check_HourFormat(Me.Heure) = 1 Then
msg = MsgBox("Le Format de l'heure n'est pas valide", vbExclamation, "Erreur")
Me.Heure = ""
Me.Heure.SetFocus
Else
Me.Heure = Mid(Me.Heure, 1, 2) & ":" & Mid(Me.Heure, 3, 2)
End If

End Sub