1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61
| Function CALC_REPORT(rCellOri As Range, dJoursArr As Date, rDureeTot As Integer, sMois As String, iAnnee As Integer) As Integer
Dim iMois As Integer
Dim iJoursRech As Integer
Dim iTampon As Integer
Dim i As Integer
'Calcul du mois
Select Case UCase(sMois)
Case "JANVIER": iMois = 1
Case "FEVRIER": iMois = 2
Case "MARS": iMois = 3
Case "AVRIL": iMois = 4
Case "MAI": iMois = 5
Case "JUIN": iMois = 6
Case "JUILLET": iMois = 7
Case "AOUT": iMois = 8
Case "SEPTEMBRE": iMois = 9
Case "OCTOBRE": iMois = 10
Case "NOVEMBRE": iMois = 11
Case "DECEMBRE": iMois = 12
End Select
If rDureeTot < (DateSerial(iAnnee, iMois + 1, 1) - 1) - dJoursArr Then
'si la durée ne dépasse pas le mois pas de report
CALC_REPORT = rDureeTot
Else
iTampon = rDureeTot - ((DateSerial(iAnnee, iMois + 1, 1) - 1) - dJoursArr)
'récupération des jours à reporter
i = 1
While iTampon > 0
If ((DateSerial(iAnnee, iMois + i + 1, 1) - 1)) - DateSerial(iAnnee, iMois + i, 1) > iTampon Then
'si la durée ne dépasse pas le nombre de jours du ième mois
rCellOri.Offset(0, 38 * i).Value = rCellOri.Offset(0, 38 * i).Value + iTampon ' reporter la valeur avec un offset, la fonction s'arrête ici elle ne devrait pas
iTampon = 0 'fin de la boucle
Else
rCellOri.Offset(0, 38 * i).Value = rCellOri.Offset(0, 38 * i).Value + (DateSerial(iAnnee, iMois + i, 1) - (DateSerial(iAnnee, iMois + i + 1, 1) - 1)) 'reporter la valeur avec un offset, la fonction s'arrête ici aussi elle ne devrait pasnon plus
iTampon = iTampon - (DateSerial(iAnnee, iMois + i, 1) - (DateSerial(iAnnee, iMois + i + 1, 1) - 1)) 'report pour la boucle suivante
i = i + 1
End If
Wend
CALC_REPORT = (DateSerial(iAnnee, iMois + 1, 1) - 1) - dJoursArr 'report de la valeur résultante
End If
End Function |
Partager