Bonjour,
description du besoin :
à partir d'une date et heure donnée je souhaite ajouter un nbre de jours ouvrés afin d'obtenir une nouvelle date et heure. Pour cela j'utilise du code VB, le pb est que dans le résultat je n'ai plus l'heure.
ci-dessous le code utilisé.
merci d'avance de votre aide
cels(k,19) : cellule de départ
cells(k,47) : cellule d'arrivée
Cells(k, 47) = PlusJOuvres(Cells(k, 19), Cells(k, 21))
Function PlusJOuvres(D, NbJours)
Dim Dt, i
Dim NbOr, Epacte As Integer
Dim PLune, LPaques, Arr(10) As Long
Dt = CLng(D)
Do
Dt = Dt + 1
'calcul du Lundi de Pâques
NbOr = (An Mod 19) + 1
Epacte = (11 * NbOr - (3 + Int(2 + Int(An / 100)) * 3 / 7)) Mod 30
PLune = DateSerial(An, 4, 19) - ((Epacte + 6) Mod 30)
If Epacte = 24 Then PLune = PLune - 1
If Epacte = 25 And (An >= 1900 And An < 2200) Then PLune = PLune - 1
LPaques = PLune - Weekday(PLune) + vbMonday + 7 'Lundi Paques
'tableau des fériés
Arr(0) = DateSerial(An, 1, 1)
Arr(1) = LPaques
Arr(2) = LPaques + 38 'Ascencion
Arr(3) = LPaques + 49 'Pentecôte
Arr(4) = DateSerial(An, 5, 1)
Arr(5) = DateSerial(An, 5, 8)
Arr(6) = DateSerial(An, 7, 14)
Arr(7) = DateSerial(An, 8, 15)
Arr(8) = DateSerial(An, 11, 1)
Arr(9) = DateSerial(An, 11, 11)
Arr(10) = DateSerial(An, 12, 25)
'ajoute si ouvré
If (IsError(Application.Match(Dt, Arr, 0))) = True And _
(Weekday(Dt, vbMonday) < 6) = True Then
i = i + 1
End If
Loop Until i = NbJours
PlusJOuvres = Dt
End Function
description du besoin :
à partir d'une date et heure donnée je souhaite ajouter un nbre de jours ouvrés afin d'obtenir une nouvelle date et heure. Pour cela j'utilise du code VB, le pb est que dans le résultat je n'ai plus l'heure.
ci-dessous le code utilisé.
merci d'avance de votre aide
cels(k,19) : cellule de départ
cells(k,47) : cellule d'arrivée
Cells(k, 47) = PlusJOuvres(Cells(k, 19), Cells(k, 21))
Function PlusJOuvres(D, NbJours)
Dim Dt, i
Dim NbOr, Epacte As Integer
Dim PLune, LPaques, Arr(10) As Long
Dt = CLng(D)
Do
Dt = Dt + 1
'calcul du Lundi de Pâques
NbOr = (An Mod 19) + 1
Epacte = (11 * NbOr - (3 + Int(2 + Int(An / 100)) * 3 / 7)) Mod 30
PLune = DateSerial(An, 4, 19) - ((Epacte + 6) Mod 30)
If Epacte = 24 Then PLune = PLune - 1
If Epacte = 25 And (An >= 1900 And An < 2200) Then PLune = PLune - 1
LPaques = PLune - Weekday(PLune) + vbMonday + 7 'Lundi Paques
'tableau des fériés
Arr(0) = DateSerial(An, 1, 1)
Arr(1) = LPaques
Arr(2) = LPaques + 38 'Ascencion
Arr(3) = LPaques + 49 'Pentecôte
Arr(4) = DateSerial(An, 5, 1)
Arr(5) = DateSerial(An, 5, 8)
Arr(6) = DateSerial(An, 7, 14)
Arr(7) = DateSerial(An, 8, 15)
Arr(8) = DateSerial(An, 11, 1)
Arr(9) = DateSerial(An, 11, 11)
Arr(10) = DateSerial(An, 12, 25)
'ajoute si ouvré
If (IsError(Application.Match(Dt, Arr, 0))) = True And _
(Weekday(Dt, vbMonday) < 6) = True Then
i = i + 1
End If
Loop Until i = NbJours
PlusJOuvres = Dt
End Function