Function RmbtMensuel(ThisMonth As Date, SubStartDate As Date, SubEndDate As Date, TotalSub As Currency) As Currency
Dim deb, nbrMoisComplet&, i, nbrJour1&, nbrJour2&, parJour@, parMois@, Avant@, apres@
deb = DateSerial(Year(SubStartDate), Month(SubStartDate), 1)
nbrMoisComplet = 1
For i = 1 To 9999
deb = DateSerial(Year(deb), Month(deb) + 1, 1)
If Format(deb, "yymm") > Format(SubEndDate, "yymm") Then Exit For
nbrMoisComplet = nbrMoisComplet + 1
Next i
If Day(SubStartDate) <> 1 Then
nbrJour1 = Application.WorksheetFunction.EoMonth(SubStartDate, 0) - SubStartDate + 1
nbrMoisComplet = nbrMoisComplet - 1
End If
If Day(SubEndDate) <> Day(Application.WorksheetFunction.EoMonth(SubEndDate, 0)) Then
nbrJour2 = Day(SubEndDate)
nbrMoisComplet = nbrMoisComplet - 1
End If
parJour = TotalSub / (nbrJour1 + nbrJour2 + 30 * nbrMoisComplet)
parMois = Round(30 * parJour, 2)
Avant = Round(nbrJour1 * parJour, 2)
apres = TotalSub - nbrMoisComplet * parMois - Avant
If Format(ThisMonth, "yymm") = Format(SubStartDate, "yymm") Then
RmbtMensuel = IIf(nbrJour1 = 0, parMois, Avant)
ElseIf Format(ThisMonth, "yymm") = Format(SubEndDate, "yymm") Then
RmbtMensuel = IIf(nbrJour2 = 0, parMois, apres)
Else
If (Format(ThisMonth, "yymm") >= Format(SubStartDate, "yymm")) And (Format(ThisMonth, "yymm") <= Format(SubEndDate, "yymm")) Then RmbtMensuel = parMois
End If
End Function