Formule VBA pour le calcul des impôts 2025

Le 14/03/2024 à 15:52
Bonjour à tous,
J'ai cherché sur la toile un code pour calculer les impôts en fonction du revenu, nombre de parts et nombre d'adultes mais ne le trouvant pas voici le mien:
Il prend en compte la décote et le plafonnement de la réduction lié au quotient familial par année.
'Pour créer ces fonctions, vous devez faire
'Appuyez sur Alt+F11 pour ouvrir Visual Basic Editor (sur le Mac, appuyez sur FN+ALT+F11),
'puis cliquez sur Insérer > Module.
'Une nouvelle fenêtre de module s’affiche sur le côté droit de Visual Basic Editor.
'Puis coller ces fonctions

Option Explicit
Function CalculImpotSansQuotient(revenu As Double, Optional annee As Integer = 2024) As Double
Dim i As Integer
Dim calculImpotParAnnee As Double
Dim Tbl As Variant, Taux As Variant

    '2025 par defaut
    Tbl = Array(0, 11600, 29579, 84577, 181917)
    Taux = Array(0, 0.11, 0.3, 0.41, 0.45)

    Select Case annee

        Case 2025
            Tbl = Array(0, 11600, 29579, 84577, 181917)
            Taux = Array(0, 0.11, 0.3, 0.41, 0.45)
        Case 2024
            Tbl = Array(0, 11497, 29315, 82823, 180294)
            Taux = Array(0, 0.11, 0.3, 0.41, 0.45)
        Case 2023
            Tbl = Array(0, 11294, 28797, 82341, 177106)
            Taux = Array(0, 0.11, 0.3, 0.41, 0.45)
        Case 2022
            Tbl = Array(0, 10777, 27478, 78570, 168994)
            Taux = Array(0, 0.11, 0.3, 0.41, 0.45)

        Case 2021
            Tbl = Array(0, 10225, 26070, 74545, 160336)
            Taux = Array(0, 0.11, 0.3, 0.41, 0.45)

        Case 2020
            Tbl = Array(0, 10084, 25710, 73516, 158122)
            Taux = Array(0, 0.11, 0.3, 0.41, 0.45)
        Case 2019
            Tbl = Array(0, 10064, 27794, 74517, 157806)
            Taux = Array(0, 0.14, 0.3, 0.41, 0.45)
        Case 2018
            Tbl = Array(0, 9964, 27519, 73779, 156244)
            Taux = Array(0, 0.14, 0.3, 0.41, 0.45)

        Case 2007
        Tbl = Array(0, 5687, 11344, 25195, 67546)
        Taux = Array(0, 0.055, 0.14, 0.3, 0.4)

        Case 2006
        Tbl = Array(0, 5614, 11198, 24872, 66679)
        Taux = Array(0, 0.055, 0.14, 0.3, 0.4)

        Case 2005
        Tbl = Array(0, 4413, 8677, 15274, 24731, 40241, 49624)
        Taux = Array(0, 0.0683, 0.194, 0.2826, 0.3738, 0.4262, 0.4809)

        Case 2004
        Tbl = Array(0, 4334, 8524, 15004, 24294, 39529, 48747)
        Taux = Array(0, 0.0683, 0.194, 0.2826, 0.3738, 0.4262, 0.4809)

        Case 2003
        Tbl = Array(0, 4263, 8382, 14753, 23888, 38868, 47932)
        Taux = Array(0, 0.0683, 0.194, 0.2826, 0.3738, 0.4262, 0.4809)

        Case 2002
        Tbl = Array(0, 4191, 8242, 14506, 23489, 38218, 47131)
        Taux = Array(0, 0.0683, 0.194, 0.2826, 0.3738, 0.4262, 0.4809)

        Case 2001
        Tbl = Array(0, 4121, 8104, 14264, 23096, 37579, 46343)
        Taux = Array(0, 0.075, 0.21, 0.31, 0.41, 0.4675, 0.5275)

        Case 2000
        Tbl = Array(0, 26600, 52320, 92090, 149110, 242620, 299200)
        Taux = Array(0, 0.085, 0.2175, 0.3175, 0.4175, 0.4725, 0.5325)
    End Select

    i = 1
    Do
        calculImpotParAnnee = calculImpotParAnnee + WorksheetFunction.Max(WorksheetFunction.Min(revenu - Tbl(i), Tbl(i + 1) - Tbl(i)), 0) * Taux(i)
        i = i + 1
    Loop While revenu > Tbl(i) And i < UBound(Tbl)

    CalculImpotSansQuotient = calculImpotParAnnee

End Function

Function CalculImpot(revenu As Double, nbPart As Double, nbAdultes As Double, Optional SalaireDejaAbattu As Boolean = False, Optional annee As Integer = 2024, Optional plafondDemiePart As Double = 1759) As Double

Dim impotParPart  As Double
Dim impotParPartRameneATouteLesParts As Double
Dim impotPourAdultes  As Double
Dim reductionImpotGraceAuxEnfants  As Double
Dim nbDemiPartSupplementaire  As Double
Dim plafondCalcule  As Double
Dim sommeAAjouterLieeAuPlafond  As Double
Dim impotAvantDecote As Double
Dim impotFinal As Double

If SalaireDejaAbattu = False Then
   revenu = revenu * 0.9 'abattement de 10%
End If

'Le plafondDemiePart est de 1759 le 14/03/2024  

'Calcul lié aux 880 € pour chaque quart de part supplémentaire. non pris en compte
'Nombre de parts - quotient familial :   2
'Nombre d'adultes dans le foyer :    1
'Revenus du foyer avant abattement de 10%:  66 667 €
'Revenus du foyer après abattement de 10%:  60 000 €
'Résultat: 7 768 €  =CalculImpot(66667;2;1)    ou    =CalculImpot(60000;2;1;TRUE)
'D'après le simulateur du gouvernement: 7 768,00 €  

impotParPart = CalculImpotSansQuotient(revenu / nbPart, annee)
impotParPartRameneATouteLesParts = impotParPart * nbPart
impotPourAdultes = CalculImpotSansQuotient(revenu / nbAdultes, annee)

reductionImpotGraceAuxEnfants = impotPourAdultes - impotParPartRameneATouteLesParts

nbDemiPartSupplementaire = (nbPart - nbAdultes) * 2

plafondCalcule = nbDemiPartSupplementaire * plafondDemiePart

sommeAAjouterLieeAuPlafond = reductionImpotGraceAuxEnfants - plafondCalcule

If sommeAAjouterLieeAuPlafond > 0 Then
   impotAvantDecote = impotParPartRameneATouteLesParts + sommeAAjouterLieeAuPlafond
Else
   impotAvantDecote = impotParPartRameneATouteLesParts
End If

If annee < 2020 Then 'Decote par cherchée avant cette date (a faire)
   CalculImpot = impotAvantDecote
Else
    'Partie decote:
    'Pour bénéficier de ce mécanisme, votre impôt sur le revenu brut ne doit pas dépasser les seuils suivants en 2024 (déclaration des revenus de 2023) :
    '
    '1 929 € pour les célibataires, divorcés, veufs
    '3 191 € pour un couple marié soumis à l'imposition commune.
    'La décote s’applique automatiquement. Pour en connaître le montant, vous devez soustraire d’un montant forfaitaire
    '(873 euros pour une personne seule ou 1 444 euros pour un couple) votre impôt brut, auquel s’applique un taux de 45,25 %.

    impotFinal = impotAvantDecote
    If (impotAvantDecote < 1929 And nbAdultes = 1) Then
        impotFinal = impotAvantDecote - (873 - (impotAvantDecote * 45.25 / 100)) '2023
    ElseIf impotAvantDecote < 3191 And nbAdultes > 1 Then
       impotFinal = impotAvantDecote - (1144 - (impotAvantDecote * 45.25 / 100)) '2023
    End If

    Select Case annee
          Case 2022
               If (impotAvantDecote < 1840 And nbAdultes = 1) Then
                    impotFinal = impotAvantDecote - (833 - (impotAvantDecote * 45.25 / 100)) '2023
                ElseIf impotAvantDecote < 3045 And nbAdultes > 1 Then
                   impotFinal = impotAvantDecote - (1307 - (impotAvantDecote * 45.25 / 100)) '2023
                End If
           Case 2021
               If (impotAvantDecote < 1746 And nbAdultes = 1) Then
                    impotFinal = impotAvantDecote - (790 - (impotAvantDecote * 45.25 / 100)) '2023
                ElseIf impotAvantDecote < 2888 And nbAdultes > 1 Then
                   impotFinal = impotAvantDecote - (1307 - (impotAvantDecote * 45.25 / 100)) '2023
                End If
           Case 2020
               If (impotAvantDecote < 1611 And nbAdultes = 1) Then
                    impotFinal = impotAvantDecote - (779 - (impotAvantDecote * 45.25 / 100)) '2023
                ElseIf impotAvantDecote < 2653 And nbAdultes > 1 Then
                   impotFinal = impotAvantDecote - (1289 - (impotAvantDecote * 45.25 / 100)) '2023
                End If
        End Select

    'Cas de calcul d'impôt à 527 euros (impotAvantDecote) pour un adulte: dans ce cas, négatif
    If impotFinal < 0 Then
      impotFinal = 0
    End If

    CalculImpot = impotFinal
End If

End Function
PS: sur ce forum, j'ai trouvé ce trois articles, mais je n'ai pas la possibilité de voir le bouton 'Répondre" :
"Formule de calcul automatique de l'impot sur le revenu"
"Calcul impôt"
Formules de calcule de tranche d'IR
Rechercher des sujets similaires à "formule vba calcul impots 2025"