bonjour, voici une macro vb pour compter le nb d'un jour particulier entre deux dates. J'aimerais savoir comment faire pour qu'il décompte automatiquement les jours fériés, merci.
'trouve le nombre d'un jour donné de la semaine entre deux dates
Function NbDe(DateDeb As Double, DateFin As Double, Jour As Byte) As Long
'le jour 1 de la semaine est le lundi
Dim i As Double, Deb#, Fin#
If DateDeb <= DateFin Then
Deb = DateDeb: Fin = DateFin
Else
Deb = DateFin: Fin = DateDeb
End If
For i = Int(Deb) To Int(Fin)
If Weekday(i, vbMonday) = Jour Then
NbDe = NbDe + 1
End If
Next i
End Function 'fs
j'ai aussi une macro pour calculer automatiquement les jours fériés, et il possible de compiler les deux, si oui comment, merci.
'comment compter un nbre de jours entre 2 dates saisies ds 2 cellules en
'otant les samedi,dimanche et jours feries
Function NbOuvrés&(D1, D2)
Dim Prem As Date, Der As Date, i As Date
If D1 = D2 Then
Prem = D1
If TYPEJOUR(Prem) = 0 Then NbOuvrés = 1
Exit Function
End If
Select Case D1 < D2
Case True: Prem = D1: Der = D2
Case False: Prem = D2: Der = D1
End Select
For i = Prem To Der
NbOuvrés = NbOuvrés + (TYPEJOUR(i) = 0) * -1
Next i
End Function
'Cette fonction renvoie 0 si le jour passé en paramètre est un jour de semaine,
'1 s'il s'agit d'un samedi ou d'un dimanche et 2 s'il s'agit d'un jour férié.
'Valide jusqu'en 2099 et pour les jours fériés français
Function TYPEJOUR(D As Date)
'L. Longre
Dim A As Integer, T As Integer
Dim LP As Date, LD As Long
Dim Toto As Long
A = Year(D)
If A > 2099 Then
TYPEJOUR = CVErr(xlErrValue)
Exit Function
End If
LD = Int(D)
If LD <= 2 Then
If LD = 1 Then TYPEJOUR = 2
Exit Function
End If
T = (((255 - 11 * (A Mod 19)) - 21) Mod 30) + 21
LP = DateSerial(A, 3, 2) + T + (T > 48) _
+ 6 - ((A + A \ 4 + T + (T > 48) + 1) Mod 7)
Select Case D
' Jours fériés mobiles
Case Is = LP, Is = LP + 38, Is = LP + 49
TYPEJOUR = 2
' Jours fériés fixes
Case Is = DateSerial(A, 1, 1), Is = DateSerial(A, 5, 1), _
Is = DateSerial(A, 5, 8), Is = DateSerial(A, 7, 14), _
Is = DateSerial(A, 8, 15), Is = DateSerial(A, 11, 1), _
Is = DateSerial(A, 11, 11), Is = DateSerial(A, 12, 25)
TYPEJOUR = 2
Case Else
' Samedi ou dimanche
If Weekday(D, vbMonday) >= 6 Then TYPEJOUR = 1
End Select
