Attribute VB_Name = "modCalculIDRIFC8"
Option Explicit

Public Sub CalculerProvisionIDRProjetee()
    On Error GoTo GestionErreur
    Dim wsPop As Worksheet
    Dim wsCalc As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim matricule As String, nom As String, prenom As String
    Dim sexe As String, csp As String, accordEntreprise As String, convention As String
    Dim ageActuel As Double, ancienneteActuelle As Double, ageDepartRetraite As Double
    Dim anneesAvantDepart As Double, ancienneteProjetee As Double
    Dim salaireMensuel As Double, remuneration12Mois As Double, remuneration3Mois As Double
    Dim salaireReference As Double, salaireProjete As Double
    Dim tauxProgressionSalariale As Double, tauxChargesPatronales As Double
    Dim tauxActualisation As Double, tauxRotation As Double
    Dim moisIndemnite As Double, indemniteBruteProjetee As Double, chargesPatronales As Double
    Dim probabilitePresence As Double, probabiliteSurvie As Double, facteurActualisation As Double
    Dim provisionIDR As Double

    Set wsPop = ThisWorkbook.Worksheets("POPULATION_SALARIES")
    Set wsCalc = ResetSheetIDR("CALCUL_IDR_IFC")
    Application.ScreenUpdating = False

    tauxProgressionSalariale = GetHypotheseTauxIDR("Taux progression salariale", 0.025)
    tauxChargesPatronales = GetHypotheseTauxIDR("Taux charges patronales", 0.42)
    tauxActualisation = GetHypotheseTauxIDR("Taux actualisation", 0.032)
    tauxRotation = GetHypotheseTauxIDR("Taux rotation", 0.05)
    ageDepartRetraite = GetHypotheseValeurNumeriqueIDR("Age depart projete", 64)
    If ageDepartRetraite = 64 Then ageDepartRetraite = GetHypotheseValeurNumeriqueIDR("Age d part projet ", 64)

    EcrireEntetesCalculIDR wsCalc
    lastRow = wsPop.Cells(wsPop.Rows.Count, 1).End(xlUp).Row
    If lastRow < 2 Then
        MsgBox "Aucune donnee dans POPULATION_SALARIES.", vbExclamation
        GoTo FinTraitement
    End If

    For i = 2 To lastRow
        matricule = CStr(wsPop.Cells(i, 1).value)
        nom = CStr(wsPop.Cells(i, 2).value)
        prenom = CStr(wsPop.Cells(i, 3).value)
        sexe = UCase(Trim(CStr(wsPop.Cells(i, 4).value)))
        csp = UCase(Trim(CStr(wsPop.Cells(i, 5).value)))
        accordEntreprise = UCase(Trim(CStr(wsPop.Cells(i, 6).value)))
        convention = UCase(Trim(CStr(wsPop.Cells(i, 11).value)))

        ageActuel = ToDoubleIDR(wsPop.Cells(i, 18).value)
        ancienneteActuelle = ToDoubleIDR(wsPop.Cells(i, 19).value)
        salaireMensuel = ToDoubleIDR(wsPop.Cells(i, 13).value)
        remuneration12Mois = ToDoubleIDR(wsPop.Cells(i, 14).value)
        remuneration3Mois = ToDoubleIDR(wsPop.Cells(i, 15).value)

        If remuneration12Mois > 0 Or remuneration3Mois > 0 Then
            salaireReference = Application.WorksheetFunction.Max(remuneration12Mois / 12, remuneration3Mois / 3)
        Else
            salaireReference = salaireMensuel
        End If

        anneesAvantDepart = ageDepartRetraite - ageActuel
        If anneesAvantDepart < 0 Then anneesAvantDepart = 0
        ancienneteProjetee = ancienneteActuelle + anneesAvantDepart
        salaireProjete = salaireReference * ((1 + tauxProgressionSalariale) ^ anneesAvantDepart)
        moisIndemnite = GetMoisIndemniteIDR(accordEntreprise, convention, csp, ancienneteProjetee)
        indemniteBruteProjetee = salaireProjete * moisIndemnite
        chargesPatronales = indemniteBruteProjetee * tauxChargesPatronales
        probabilitePresence = (1 - tauxRotation) ^ anneesAvantDepart
        probabiliteSurvie = GetProbabiliteSurvieSelonSexeIDR(ageActuel, ageDepartRetraite, sexe)
        facteurActualisation = 1 / ((1 + tauxActualisation) ^ anneesAvantDepart)
        provisionIDR = (indemniteBruteProjetee + chargesPatronales) * probabilitePresence * probabiliteSurvie * facteurActualisation

        wsCalc.Cells(i, 1).value = matricule
        wsCalc.Cells(i, 2).value = nom
        wsCalc.Cells(i, 3).value = prenom
        wsCalc.Cells(i, 4).value = sexe
        wsCalc.Cells(i, 5).value = csp
        wsCalc.Cells(i, 6).value = accordEntreprise
        wsCalc.Cells(i, 7).value = convention
        wsCalc.Cells(i, 8).value = ageActuel
        wsCalc.Cells(i, 9).value = ancienneteActuelle
        wsCalc.Cells(i, 10).value = salaireMensuel
        wsCalc.Cells(i, 11).value = remuneration12Mois
        wsCalc.Cells(i, 12).value = remuneration3Mois
        wsCalc.Cells(i, 13).value = salaireReference
        wsCalc.Cells(i, 14).value = ageDepartRetraite
        wsCalc.Cells(i, 15).value = anneesAvantDepart
        wsCalc.Cells(i, 16).value = ancienneteProjetee
        wsCalc.Cells(i, 17).value = tauxProgressionSalariale
        wsCalc.Cells(i, 18).value = salaireProjete
        wsCalc.Cells(i, 19).value = moisIndemnite
        wsCalc.Cells(i, 20).value = indemniteBruteProjetee
        wsCalc.Cells(i, 21).value = tauxChargesPatronales
        wsCalc.Cells(i, 22).value = chargesPatronales
        wsCalc.Cells(i, 23).value = probabilitePresence
        wsCalc.Cells(i, 24).value = probabiliteSurvie
        wsCalc.Cells(i, 25).value = tauxActualisation
        wsCalc.Cells(i, 26).value = facteurActualisation
        wsCalc.Cells(i, 27).value = provisionIDR
    Next i

    MettreEnFormeCalculIDR wsCalc
    MsgBox lastRow - 1 & " provisions IDR projetees calculees.", vbInformation

FinTraitement:
    Application.ScreenUpdating = True
    Exit Sub
GestionErreur:
    Application.ScreenUpdating = True
    MsgBox "Erreur CalculerProvisionIDRProjetee ligne population " & i & " : " & Err.Number & " - " & Err.Description, vbCritical
End Sub

Private Sub EcrireEntetesCalculIDR(ByVal ws As Worksheet)
    ws.Cells(1, 1).value = "Matricule"
    ws.Cells(1, 2).value = "Nom"
    ws.Cells(1, 3).value = "Prenom"
    ws.Cells(1, 4).value = "Sexe"
    ws.Cells(1, 5).value = "CSP"
    ws.Cells(1, 6).value = "Accord_Entreprise"
    ws.Cells(1, 7).value = "Convention"
    ws.Cells(1, 8).value = "Age"
    ws.Cells(1, 9).value = "Anciennete"
    ws.Cells(1, 10).value = "Salaire_Brut_Mensuel"
    ws.Cells(1, 11).value = "Remuneration_12_Mois"
    ws.Cells(1, 12).value = "Remuneration_3_Mois"
    ws.Cells(1, 13).value = "Salaire_Reference"
    ws.Cells(1, 14).value = "Age_Depart_Retraite"
    ws.Cells(1, 15).value = "Annees_Avant_Depart"
    ws.Cells(1, 16).value = "Anciennete_Projetee"
    ws.Cells(1, 17).value = "Taux_Progression_Salariale"
    ws.Cells(1, 18).value = "Salaire_Projete"
    ws.Cells(1, 19).value = "Mois_Indemnite"
    ws.Cells(1, 20).value = "Indemnite_Brute_Projetee"
    ws.Cells(1, 21).value = "Taux_Charges_Patronales"
    ws.Cells(1, 22).value = "Charges_Patronales"
    ws.Cells(1, 23).value = "Probabilite_Presence"
    ws.Cells(1, 24).value = "Probabilite_Survie"
    ws.Cells(1, 25).value = "Taux_Actualisation"
    ws.Cells(1, 26).value = "Facteur_Actualisation"
    ws.Cells(1, 27).value = "Provision_IDR"
End Sub

Private Function GetHypotheseTauxIDR(ByVal Parametre As String, ByVal valeurDefaut As Double) As Double
    Dim Valeur As Variant
    Dim taux As Double
    Valeur = GetHypotheseValeurIDR(Parametre, valeurDefaut)
    If IsNumeric(Valeur) Then
        taux = CDbl(Valeur)
        If taux > 1 Then taux = taux / 100
        GetHypotheseTauxIDR = taux
    Else
        GetHypotheseTauxIDR = valeurDefaut
    End If
End Function

Private Function GetHypotheseValeurNumeriqueIDR(ByVal Parametre As String, ByVal valeurDefaut As Double) As Double
    Dim Valeur As Variant
    Valeur = GetHypotheseValeurIDR(Parametre, valeurDefaut)
    If IsNumeric(Valeur) Then
        GetHypotheseValeurNumeriqueIDR = CDbl(Valeur)
    Else
        GetHypotheseValeurNumeriqueIDR = valeurDefaut
    End If
End Function

Private Function GetHypotheseValeurIDR(ByVal Parametre As String, ByVal valeurDefaut As Variant) As Variant
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    If Not SheetExistsIDR("REF_HYPOTHESES_ACTUARIELLES") Then
        GetHypotheseValeurIDR = valeurDefaut
        Exit Function
    End If
    Set ws = ThisWorkbook.Worksheets("REF_HYPOTHESES_ACTUARIELLES")
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    For i = 2 To lastRow
        If UCase(Trim(CStr(ws.Cells(i, 3).value))) = UCase(Trim(Parametre)) And UCase(Trim(CStr(ws.Cells(i, 10).value))) = "ACTIF" Then
            GetHypotheseValeurIDR = ws.Cells(i, 4).value
            Exit Function
        End If
    Next i
    GetHypotheseValeurIDR = valeurDefaut
End Function

Private Function GetProbabiliteSurvieSelonSexeIDR(ByVal ageActuel As Double, ByVal ageDepart As Double, ByVal sexe As String) As Double
    Dim ws As Worksheet
    Dim age As Long
    Dim px As Double
    Dim proba As Double
    Dim colonnePx As String
    proba = 1
    If Not SheetExistsIDR("TABLE_MORTALITE") Then
        GetProbabiliteSurvieSelonSexeIDR = 1
        Exit Function
    End If
    Set ws = ThisWorkbook.Worksheets("TABLE_MORTALITE")
    If ageDepart <= ageActuel Then
        GetProbabiliteSurvieSelonSexeIDR = 1
        Exit Function
    End If
    Select Case sexe
        Case "H", "HOMME", "M"
            colonnePx = "Homme_px"
        Case "F", "FEMME"
            colonnePx = "Femme_px"
        Case Else
            GetProbabiliteSurvieSelonSexeIDR = GetProbabiliteSurvieMoyenneIDR(ageActuel, ageDepart)
            Exit Function
    End Select
    For age = CLng(Int(ageActuel)) To CLng(Int(ageDepart)) - 1
        px = GetPxAgeCalculIDR(ws, age, colonnePx)
        If px <= 0 Or px > 1 Then px = 1
        proba = proba * px
    Next age
    GetProbabiliteSurvieSelonSexeIDR = proba
End Function

Private Function GetProbabiliteSurvieMoyenneIDR(ByVal ageActuel As Double, ByVal ageDepart As Double) As Double
    Dim ws As Worksheet
    Dim age As Long
    Dim pxH As Double
    Dim pxF As Double
    Dim proba As Double
    proba = 1
    If Not SheetExistsIDR("TABLE_MORTALITE") Then
        GetProbabiliteSurvieMoyenneIDR = 1
        Exit Function
    End If
    Set ws = ThisWorkbook.Worksheets("TABLE_MORTALITE")
    If ageDepart <= ageActuel Then
        GetProbabiliteSurvieMoyenneIDR = 1
        Exit Function
    End If
    For age = CLng(Int(ageActuel)) To CLng(Int(ageDepart)) - 1
        pxH = GetPxAgeCalculIDR(ws, age, "Homme_px")
        pxF = GetPxAgeCalculIDR(ws, age, "Femme_px")
        If pxH <= 0 Or pxH > 1 Then pxH = 1
        If pxF <= 0 Or pxF > 1 Then pxF = 1
        proba = proba * ((pxH + pxF) / 2)
    Next age
    GetProbabiliteSurvieMoyenneIDR = proba
End Function

Private Function GetPxAgeCalculIDR(ByVal ws As Worksheet, ByVal ageRecherche As Long, ByVal colonnePx As String) As Double
    Dim colAge As Long
    Dim colPx As Long
    Dim lastRow As Long
    Dim i As Long
    colAge = GetColumnByHeaderIDR(ws, "Age")
    colPx = GetColumnByHeaderIDR(ws, colonnePx)
    If colAge = 0 Or colPx = 0 Then
        GetPxAgeCalculIDR = 1
        Exit Function
    End If
    lastRow = ws.Cells(ws.Rows.Count, colAge).End(xlUp).Row
    For i = 2 To lastRow
        If IsNumeric(ws.Cells(i, colAge).value) Then
            If CLng(ws.Cells(i, colAge).value) = ageRecherche Then
                If IsNumeric(ws.Cells(i, colPx).value) Then
                    GetPxAgeCalculIDR = CDbl(ws.Cells(i, colPx).value)
                Else
                    GetPxAgeCalculIDR = 1
                End If
                Exit Function
            End If
        End If
    Next i
    GetPxAgeCalculIDR = 1
End Function

Private Sub MettreEnFormeCalculIDR(ByVal ws As Worksheet)
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    FormatReferentielIDR ws, "A1:AA1"
    ws.Range("J2:M" & lastRow).NumberFormat = "#,##0.00"
    ws.Range("R2:R" & lastRow).NumberFormat = "#,##0.00"
    ws.Range("T2:T" & lastRow).NumberFormat = "#,##0.00"
    ws.Range("V2:V" & lastRow).NumberFormat = "#,##0.00"
    ws.Range("AA2:AA" & lastRow).NumberFormat = "#,##0.00"
    ws.Range("Q2:Q" & lastRow).NumberFormat = "0.00%"
    ws.Range("U2:Z" & lastRow).NumberFormat = "0.00%"
    ws.Columns.AutoFit
End Sub