par Michael DELIQUE » 22 Juil 2005 à 13:52
- Code : Tout sélectionner
Function nbDayInMonth(Byval wdate As String, Byval wnbMonth As Integer, Byval wnbYear As Integer) As Integer
'cette fonction renvois le nombre du jour contenue dans un mois.
'passer une date ou le mois et l'année (n'est nécessaire que que pour le mois de février) séparement
'Déclaration Variable
Dim nbMonth As Integer
Dim nbYear As Integer
On Error Goto ErreurnbDayInMonth
If Trim(Date) = "" Then
nbMonth = wnbMonth
nbYear = wnbYear
Else
nbMonth = Cint(Format(wDate,"mm"))
nbYear = Cint(Format(wDate,"yyyy"))
End If
Select Case nbMonth
Case 1,3,5,7,8,10,12
'mois de 31 jours
nbDayInMonth = 31
Case 4,6,9,11
'mois de 30 jour
nbDayInMonth = 30
Case 2
' le nombre de jour du mois de février varie si l'année est bissextile.
If nbYear < 1500 Then
Error 9999,"L'année est incorrect (elle doit être supérieur à 1500) : "+Cstr(nbYear)
Exit Function
End If
If isBissextile(nbYear) = True Then
nbDayInMonth = 29
Else
nbDayInMonth = 28
End If
Case Else
Error 9999,"Le numéro du mois est incorrect : "+Cstr(nbMonth)
Exit Function
End Select
nbMonth = 0
nbYear = 0
Exit Function
ErreurnbDayInMonth:
Msgbox "(nbDayInMonth) Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
nbMonth = 0
nbYear = 0
nbDayInMonth = 0
Exit Function
End Function
- Code : Tout sélectionner
Function isBissextile(Byval wnbYear) As Integer
'L’année est bissextile si elle est divisible par quatre.
'Toutefois, les années divisibles par 100 ne sont pas bissextiles,
'mais les années divisibles par 400 le sont.
'Déclaration Variable
Dim nbYear As Integer
On Error Goto ErreurHandle
Select Case Abs(wnbYear)
Case 0
Error 9999, "wnbYear = 0"
Exit Function
Case Is < 101
'si inférieur à 100 on considère que la date est sur 2 chiffres
nbYear = 2000+ Abs(wnbYear)
Case 101 To 1500
Error 9999, "wnbYear <1500 & > 100"
Exit Function
Case Is > 3000
Error 9999, "wnbYear > 3000"
Exit Function
Case Else
nbYear = Abs(wnbYear)
End Select
If nbYear Mod 4 = 0 Then
If nbYear Mod 100 = 0 Then
If nbYear Mod 400 = 0 Then
isBissextile = True
Else
isBissextile = False
End If
Else
isBissextile = True
End If
Else
isBissextile = False
End If
nbYear = 0
Exit Function
ErreurIsBissextile:
Msgbox "(IsBissextile) Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
isBissextile = False
Exit Function
End Function
