DevWiki de Yosko

Cette page est en lecture seule. Vous pouvez afficher le texte source, mais ne pourrez pas le modifier. Contactez votre administrateur si vous pensez qu'il s'agit d'une erreur.
====== Fonctions de dates ======

Fonctions [[VBA:VBA|VBA]] relatives aux dates.

===== Calcul du nombre de jours par année =====
	
<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

{{tag>date vba}}