Calcul impôt sur le revenu

**sergentgarcia** · 15/03/2008, 23h50

Voici une fonction Excel permettant de calculer l'impôt sur le revenu à payer en fonction du revenu net imposable et de l'année d'imposition.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Function IR(Rimposable As Double, Optional Annee As Variant = 2007) As Double
Dim i As Integer
Dim Tbl As Variant, Taux As Variant
 
Select Case Annee
    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
        IR = IR + WorksheetFunction.Max(WorksheetFunction.Min( _
        Rimposable - Tbl(i), Tbl(i + 1) - Tbl(i)), 0) * Taux(i)
        i = i + 1
    Loop While Rimposable > Tbl(i) And i < UBound(Tbl)
 
End Function

**hermes6236** · 21/11/2018, 22h26

testé mais la fonction semble erroné

de plus les valeurs des seuils n'est pas bon

**hermes6236** · 22/11/2018, 12h19

avant de produire ce code en vba, j'ai été étonnée après avoir farfouillé tous les forums de ne pas avoir trouvé des exemples déjà fait du calcul de l'impôt sur le revenu ou de l'impôt sur les sociétés

voilà j'ai dû corriger, et même amélioré en ajoutant des fonctions supplémentaires,

voilà pour le calcul de l'impôt sur le revenu,
avec une option possible de prise en compte des parts,
avec une option possible d'avoir en retour le TMI c'est-à-dire le taux marginal d'imposition

il n'y a qu'en France où l'on est obligé d'en arriver à là, c'est-à-dire d'en arriver à devoir faire de la programmation (non à la porté de tous) afin de pouvoir faire face aux mille-feuille administratif et fiscal de notre République ,

Samedi tous à PARIS avec les gilets jaunes !!!!

Enjoy

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
 
 
Option Explicit
 
Function Impot_Revenu(Revenu_Imposable As Double, Optional Annee As Variant = "", Optional Part As Double = 1, Optional Retour_fonction As String = "") As Double
 
' On Error Resume Next
Application.Calculation = xlCalculationManual
Application.volatile True
 
Dim i As Integer
Dim Tbl As Variant, Taux As Variant
Dim TMI As Double
 
If (Annee = "") Then Annee = Year(Now())
If (Annee > 2019) Then Annee = 2019
If (Annee < 2000) Then Annee = 2000
 
If (Part <> 1) Then Revenu_Imposable = Revenu_Imposable / Part
 
Select Case Annee
 
' https://fr.wikipedia.org/wiki/Bar%C3%A8mes_de_l%27imp%C3%B4t_sur_le_revenu_en_France
 
    Case 2019
    Tbl = Array(0, 9964, 27519, 73779, 156244)
    Taux = Array(0, 0.14, 0.3, 0.41, 0.45)
 
    Case 2018
    Tbl = Array(0, 9807, 27086, 72617, 153783)
    Taux = Array(0, 0.14, 0.3, 0.41, 0.45)
 
    Case 2017
    Tbl = Array(0, 9690, 26764, 71754, 151956)
    Taux = Array(0, 0.14, 0.3, 0.41, 0.45)
 
    Case 2016
    Tbl = Array(0, 9710, 26818, 71898, 152260)
    Taux = Array(0, 0.14, 0.3, 0.41, 0.45)
 
    Case 2015
    Tbl = Array(0, 9700, 26791, 71826, 152108)
    Taux = Array(0, 0.14, 0.3, 0.41, 0.45)
 
    Case 2014
    Tbl = Array(0, 9690, 26764, 71754, 151956)
    Taux = Array(0, 0.14, 0.3, 0.41, 0.45)
 
    Case 2013
    Tbl = Array(0, 6011, 11991, 26631, 71397, 151200)
    Taux = Array(0, 0.055, 0.14, 0.3, 0.41, 0.45)
 
    Case 2012
    Tbl = Array(0, 5963, 11896, 26420, 70830, 150000)
    Taux = Array(0, 0.055, 0.14, 0.3, 0.41, 0.45)
 
    Case 2011
    Tbl = Array(0, 5963, 11896, 26420, 70830)
    Taux = Array(0, 0.055, 0.14, 0.3, 0.41)
 
    Case 2010
    Tbl = Array(0, 5963, 11896, 26420, 70830)
    Taux = Array(0, 0.055, 0.14, 0.3, 0.41)
 
    Case 2009
    Tbl = Array(0, 5875, 11720, 26030, 69783)
    Taux = Array(0, 0.055, 0.14, 0.3, 0.4)
 
    Case 2008
    Tbl = Array(0, 5852, 11673, 25926, 69505)
    Taux = Array(0, 0.055, 0.14, 0.3, 0.4)
 
    Case 2007
    Tbl = Array(0, 5614, 11198, 248725, 66679)
    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, 4412, 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 = 0
    Do
        Impot_Revenu = Impot_Revenu + WorksheetFunction.Max(WorksheetFunction.Min( _
        Revenu_Imposable - Tbl(i), Tbl(i + 1) - Tbl(i)), 0) * Taux(i)
        TMI = Taux(i)
        i = i + 1
    Loop While Revenu_Imposable > Tbl(i) And i < UBound(Tbl)
        If Revenu_Imposable > Tbl(UBound(Tbl)) Then
            Impot_Revenu = Impot_Revenu + ((Revenu_Imposable - Tbl(UBound(Tbl))) * Taux(UBound(Tbl)))
            TMI = Taux(UBound(Tbl))
        End If
 
If (Part <> 1) Then Impot_Revenu = Impot_Revenu * Part
 
If (Retour_fonction <> "") Then Impot_Revenu = TMI
 
Application.Calculation = xlCalculationAutomatic
 
End Function

RAF

**hermes6236** · 22/11/2018, 12h21

voilà pour le calcul de l'impôt sur les sociétés,

Enjoy

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
62
63
 
 
Option Explicit
 
Function Impot_Societe(Resultat_Imposable As Double, Optional Annee As Variant = "") As Double
 
' On Error Resume Next
Application.Calculation = xlCalculationManual
Application.volatile True
 
Dim x As Double
Dim i As Integer
Dim Tbl As Variant, Taux As Variant
 
If (Annee = "") Then Annee = Year(Now())
If (Annee > 2022) Then Annee = 2022
If (Annee < 2016) Then Annee = 2016
 
Select Case Annee
 
' https://www.legifiscal.fr/actualites-fiscales/1732-2018-is-28-500000-benefices.html
 
    Case 2022
    Tbl = Array(0, 38120)
    Taux = Array(0.15, 0.25)
 
    Case 2021
    Tbl = Array(0, 38120)
    Taux = Array(0.15, 0.265)
 
    Case 2020
    Tbl = Array(0, 38120)
    Taux = Array(0.15, 0.28)
 
    Case 2019
    Tbl = Array(0, 38120, 500000)
    Taux = Array(0.15, 0.28, 0.31)
 
    Case 2018
    Tbl = Array(0, 38120, 500000)
    Taux = Array(0.15, 0.28, 0.33)
 
    Case 2017
    Tbl = Array(0, 38120, 75000)
    Taux = Array(0.15, 0.28, 0.33)
 
    Case 2016
    Tbl = Array(0, 38120)
    Taux = Array(0.15, 0.33)
 
End Select
 
        i = 0
    Do
        Impot_Societe = Impot_Societe + WorksheetFunction.Max(WorksheetFunction.Min( _
        Resultat_Imposable - Tbl(i), Tbl(i + 1) - Tbl(i)), 0) * Taux(i)
        i = i + 1
    Loop While Resultat_Imposable > Tbl(i) And i < UBound(Tbl)
        If Resultat_Imposable > Tbl(UBound(Tbl)) Then Impot_Societe = Impot_Societe + ((Resultat_Imposable - Tbl(UBound(Tbl))) * Taux(UBound(Tbl)))
 
Application.Calculation = xlCalculationAutomatic
 
End Function

RAF

**AlexGa** · 17/12/2018, 10h36

Bonjour Hermes6236,

Votre code est intéressant mais il manque pour mois une fonction importante: le plafonnement du quotient familial. En effet pour un couple marié ayant 4 enfants et un revenu imposable de 120 000€, l'impôt n'est pas de 9 935,1€ dans votre code mais bien de 15 424,52€.

Bien à vous !

re · 13/03/2019, 13h41

Bonjour,
je ne suis pas un spécialiste du vba, comment inserer ton code dans un module ?
Je suppose qu'il manque pas mal de chose pour ça fonctionne ,-)

Merci beaucoup pour le partage

**sergeluc** · 21/03/2019, 18h16

Bonjour et merci hermes6236 pour ces 2 fonctions

**OlivierCha** · 14/03/2024, 17h21

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.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
 
'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
 
   '2023 par defaut
    Tbl = Array(0, 11294, 28797, 82341, 177106)
    Taux = Array(0, 0.11, 0.3, 0.41, 0.45)
 
    Select Case annee
        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

Bonne journée,
Olivier

**OlivierCha** · 27/05/2026, 23h03

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
'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
'https://support.microsoft.com/fr-fr/office/cr%C3%A9er-des-fonctions-personnalis%C3%A9es-dans-excel-2f06c10b-3622-40d6-a1b2-b6748ae8231f
 
Option Explicit
Function CalculImpotSansQuotient(revenu As Double, Optional annee As Integer = 2024) As Double
'https://www.developpez.net/forums/d509486/logiciels/microsoft-office/general-vba/contribuez/calcul-impot-revenu/
Dim i As Integer
Dim calculImpotParAnnee As Double
Dim Tbl As Variant, Taux As Variant
Dim NextPalier As Double
 
   '2025 par defaut
    Tbl = Array(0, 11600, 29579, 84577, 181917)
    Taux = Array(0, 0.11, 0.3, 0.41, 0.45)
 
    Select Case annee
       'https://fr.wikipedia.org/wiki/Bar%C3%A8mes_de_l%27imp%C3%B4t_sur_le_revenu_en_France
        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 2017
            Tbl = Array(0, 9807, 27086, 72617, 153783)
            Taux = Array(0, 0.14, 0.3, 0.41, 0.45)
        Case 2016
            Tbl = Array(0, 9710, 26818, 71898, 152260)
            Taux = Array(0, 0.14, 0.3, 0.41, 0.45)
        Case 2015
            Tbl = Array(0, 9700, 26791, 71826, 152108)
            Taux = Array(0, 0.14, 0.3, 0.41, 0.45)
        Case 2014
            Tbl = Array(0, 9690, 26764, 71754, 151956)
            Taux = Array(0, 0.14, 0.3, 0.41, 0.45)
        Case 2013
            Tbl = Array(0, 6011, 11991, 26631, 71397, 151200)
            Taux = Array(0, 0.05, 0.14, 0.3, 0.41, 0.45)
        Case 2012
            Tbl = Array(0, 5963, 11896, 26420, 70830, 150000)
            Taux = Array(0, 0.05, 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
 
 
 
    calculImpotParAnnee = 0
    i = 1
    Do
        NextPalier = 999999999999#
        If (i < UBound(Tbl)) Then
           NextPalier = Tbl(i + 1)
        End If
 
        calculImpotParAnnee = calculImpotParAnnee + WorksheetFunction.Max(WorksheetFunction.Min(revenu - Tbl(i), NextPalier - Tbl(i)), 0) * Taux(i)
        i = i + 1
    Loop While i <= UBound(Tbl) And revenu > NextPalier
 
 
    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 pensionAlimentaire As Double = 0, Optional devoirDeSecours As Double = 0) 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
Dim plafondDemiePart As Double
 
If SalaireDejaAbattu = False Then
   revenu = revenu * 0.9 'abattement de 10%
End If
 
'Le plafondDemiePart est de 1759 le 14/03/2024   <a href="https://www.economie.gouv.fr/particuliers/tranches-imposition-impot-revenu" target="_blank">https://www.economie.gouv.fr/particu...n-impot-revenu</a>
plafondDemiePart = 1759
'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 €  (<a href="https://simulateur-ir-ifi.impots.gouv.fr" target="_blank">https://simulateur-ir-ifi.impots.gouv.fr</a>)
 
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)
   impotFinal = impotAvantDecote
Else
    'Partie decote:
    'https://www.economie.gouv.fr/particuliers/tranches-imposition-impot-revenu
    '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
               'https://www.economie.gouv.fr/particuliers/decote-impot-revenu
               If (impotAvantDecote < 1840 And nbAdultes = 1) Then
                    impotFinal = impotAvantDecote - (833 - (impotAvantDecote * 45.25 / 100))
                ElseIf impotAvantDecote < 3045 And nbAdultes > 1 Then
                   impotFinal = impotAvantDecote - (1307 - (impotAvantDecote * 45.25 / 100))
                End If
          'https://www.boursorama.com/patrimoine/fiches-pratiques/2021-une-decote-d-impot-nouvelle-version-deb7ef74b1172895f187ec6856ebb7e0
          'https://impotsurlerevenu.org/comprendre-le-calcul-de-l-impot/559-decote-de-l-impot.php
           Case 2021
               If (impotAvantDecote < 1746 And nbAdultes = 1) Then
                    impotFinal = impotAvantDecote - (790 - (impotAvantDecote * 45.25 / 100))
                ElseIf impotAvantDecote < 2888 And nbAdultes > 1 Then
                   impotFinal = impotAvantDecote - (1307 - (impotAvantDecote * 45.25 / 100))
                End If
           Case 2020
               If (impotAvantDecote < 1611 And nbAdultes = 1) Then
                    impotFinal = impotAvantDecote - (779 - (impotAvantDecote * 45.25 / 100))
                ElseIf impotAvantDecote < 2653 And nbAdultes > 1 Then
                   impotFinal = impotAvantDecote - (1289 - (impotAvantDecote * 45.25 / 100))
                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
 
 
End If
 
impotFinal = impotFinal - 0.3 * pensionAlimentaire * 12
impotFinal = impotFinal - 0.25 * devoirDeSecours * 12
 
If impotFinal < 0 Then
  impotFinal = 0
End If
 
CalculImpot = impotFinal
End Function

Calcul impôt sur le revenu

Contribuez

Discussions similaires

Partager

Partager