Fonctions VBA relatives aux dates.
<note important>Il s'agit ici d'une version simplifiée ne gérant que des dates situées soit dans la même année, soit sur deux années consécutives. Pour un écart plus important, il est nécessaire d'adapter le code.</note>
Public Function fn_nbJoursParAnnee(ByVal pd_date1 As Date, ByVal pd_date2 As Date) As Integer()
'******************************************************************************
' But : Calcul le nombre de jour (NON ouvrés) situé sur chaque année entre les 2 dates
' : -> gère 2 années UNIQUEMENT
' Entrée : date1 : date de début
' : date2 : date de fin
' Sortie : tableau d'entiers : nombre de jours sur chaque année
'******************************************************************************
' --- Déclarations
Dim li_nbJours(2) As Integer
' --- Gestion des erreurs
On Error GoTo etq_erreur
' --- Initialisation
' --- Traitement
' si les deux dates ne sont pas sur la même année
If Year(pd_date1) <> Year(pd_date2) Then
' on calcule le nombre de jour sur chaque année
li_nbJours(1) = DateDiff("d", pd_date1, CDate("31/12/" & Year(pd_date1)))
li_nbJours(2) = DateDiff("d", CDate("01/01/" & Year(pd_date2)), pd_date2)
Else
' sinon, on retourne le nombre de jour dans sa totalité sur l'année 1
li_nbJours(1) = DateDiff("d", pd_date1, pd_date2)
li_nbJours(2) = 0
End If
' --- Fin de traitement
etq_fin_traitement:
' on retourne les nombres de jours sur chacune des 2 années
fn_nbJoursParAnnee = li_nbJours
Exit Function
' --- Traitement des erreurs
etq_erreur:
' affichage du message d'erreur
Call MsgBox("Erreur n°" & Err.Number & " :" & vbCrLf & Err.description, vbCritical + vbOKOnly, "App - Erreur")
Resume etq_fin_traitement
End Function
date vba