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
| Sub NouvelleAnnee()
Dim NomFeuille As String
Dim An As Integer
Dim Couleur
Dim Sh As Shape
Application.ScreenUpdating = False
Couleur = Array(3, 4, 5, 6, 7, 8, 9, 10, 17, 40, 49, 42)
With ActiveSheet
An = Val(Split(.Name, " ")(1))
If An = 0 Then
MsgBox "Nom de la feuille non conforme"
Exit Sub
End If
' .Unprotect
NomFeuille = "Charges " & An + 1 'Espace après Charges affiche Charges 2014.Supprimer Espace affiche par exemple Charges2014
If FeuilleExiste(NomFeuille) = True Then
MsgBox "L'Année " & NomFeuille & " existe déjà "
Exit Sub
End If
' .Unprotect
.Copy after:=Sheets(Sheets.Count)
'.Shapes("AnneePlus").Delete 'Mettre en commentaires pour ne pas effacer le bouton (nouvelle année)de la Feuille Précédente
' .Protect
End With
With ActiveSheet
Application.Calculation = xlCalculationManual ' Modif le 29/11/2020
' .Unprotect
.Name = NomFeuille
.Tab.ColorIndex = Couleur((An - 2000) Mod 12)
'Code pour tester les cellules qui doivent être effacées : on les colorie en rouge
' Application.EnableEvents = False
' .Range("E3:E9,A12:C14,E12:E14,A18:C32,E18:E32,A35:C37,E35:E37,A39:C55,E39:E55,A58:C60,E58:E60,A72:C78,E72:E78,A81:C83," & _
' "E81:E83,A85:A101,E85:E101,F5,F10,F33,F56,F79,G18:I22,G23:I32,G39:I45,G46:I55,G62:I68,G69:I78,G85,G92:I101,G107,G109,G111".Interior.ColorIndex = 3
' Application.EnableEvents = True
' Code normal pour effacer
On Error Resume Next
' Attention aux nombre de cellules dans la même ligne. Si code trop long ça n'efface pas.Privilégier G8,G113,G116,G118 Code sur 1 ligne.
.Range("E3:E9,A12:C14,E12:E14,A16:C32,E16:E32,A35:C37,E35:E37,A39:C55,E39:E55,A58:C60,E58:E60,A62:C78,E62:E78,A81:C83," & _
"E81:E83,A85:A101,E85:E101,F5,F10,F33,F56,F79,G18:I22,G23:I32,G39:I45,G46:I55,G62:I68,G69:I78,G85,G92:I101,G107,G109,G111").SpecialCells(xlCellTypeConstants, 23).ClearContents
On Error GoTo 0
Range("G10,G109,G111") = 0 'Si on ne fait pas effacer les Cellules "G10,G109,G111" par la macro ci-dessus il faut mettre cettre ligne en NON COMMENTAIRES
' Début Modifications du 15/03/2020 : Evite l'effacement des textes en colonne A
Application.EnableEvents = False
.Cells.Replace What:=An, Replacement:=An + 1 '1ère phase on augmente de 1 l'année supérieure
.Cells.Replace What:=An - 1, Replacement:=An '2ème phase on augmente de 1 l'année inférieure
Application.EnableEvents = True
' Fin Modifications du 15/03/2020: Evite l'effacement des textes en colonne A
Call Joli(.[A1], 1, 13, 5) 'Ajouter 5 pour la couleur bleu (5) ligne 1
Call Joli(.[A1], 14, 1, 15) 'Ajouter 15 pour qu'entre Charges et Année 2020 par exemple on ne voit pas le soulignement (mëme couleur que le fond soit 15)
Call Joli(.[A1], 15, 4)
.Range("A3").Font.ColorIndex = 1 'Si le texte ne commence pas par du noir il faut appliquer cette ligne
Call Joli(.[A3], 1, 5)
Call Joli(.[A3], 30, 25)
Call Joli(.[A3], 64, 2)
Call Joli(.[A4], 7, 26)
Call Joli(.[A4], 43, 2)
.Range("A5").Font.ColorIndex = 2 'Si le texte ne commence pas par du noir il faut appliquer cette ligne
Call Joli(.[A5], 1, 5) ' Annuel
Call Joli(.[A5], 15, 6)
Call Joli(.[A5], 41, 5)
Call Joli(.[A5], 56, 2)
Call Joli(.[A6], 9, 14)
Call Joli(.[A6], 48, 2)
Call Joli(.[A6], 53, 1)
.Range("A7").Font.ColorIndex = 2 'Si le texte ne commence pas par du noir il faut appliquer cette ligne
Call Joli(.[A7], 1, 5)
Call Joli(.[A7], 31, 6)
Call Joli(.[A7], 44, 11)
Call Joli(.[A7], 63, 3)
.Range("A8").Font.ColorIndex = 1 'Si le texte ne commence pas par du noir il faut appliquer cette ligne
Call Joli(.[A8], 1, 5) 'Ajouter 5 pour la couleur bleu (5) ligne 8
Call Joli(.[A8], 29, 27, 5) 'Ajouter 1 pour la couleur noir (1) ligne 8
Call Joli(.[A8], 65, 2)
Call Joli(.[A9], 7, 7)
Call Joli(.[A9], 43, 3)
Call Joli(.[A103], 25, 6)
Call Joli(.[A103], 39, 3)
.Range("A108").Font.ColorIndex = 2 'Si le texte ne commence pas par du noir il faut appliquer cette ligne
Call Joli(.[A108], 1, 5)
Call Joli(.[A108], 33, 5)
Call Joli(.[A108], 48, 4)
Call Joli(.[G5], 32, 5)
'Début modifs modif le 22/10/2022
.[I5].FormulaR1C1 = _
"=ROUND(SUM(ABS('Charges " & An & "'!R[99]C[-3]),-R[-2]C[-4])/12,2)"
.[I6].FormulaR1C1 = _
"=ROUND(('Charges " & An & "'!R[98]C[-3]*-1)-(R[98]C[-3]*-1),2)*-1"
'Fin modifs modif le 22/10/2022
CelluleG6 ActiveSheet
For Each Sh In .Shapes 'Ces 10 lignes pour ajouter une année.
If Sh.TopLeftCell.Column = 7 Then '7 = Colonne G
With Sh.TextFrame.Characters(Start:=51, Length:=4)
.Insert An + 1 ' Incrémentation d'un an
.Font.ColorIndex = 3 ' Couleur année
.Font.Size = 16 ' Taille texte
End With
Exit For
End If
Next Sh
' .Protect UserInterfaceOnly:=True
.[A1].Select
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub Joli(A As Range, Start As Integer, Length As Integer, Optional Couleur As Integer = 3) 'Ajouter la Macro "Joli" pour que le Programme fonctionne
A.Characters(Start, Length).Font.ColorIndex = Couleur
End Sub
Sub CelluleG6(Ws As Worksheet)
Dim An As Integer
On Error GoTo GestionErreur ' Modif le 16/10/2022
Application.EnableEvents = False
With Ws
' .Unprotect
Application.Calculation = xlCalculationAutomatic 'Pour forcer Calcul Automatique si on Ajoute des lignes
An = Val(Split(.Name, " ")(1))
If .[I6] < 0 Then ' Mettre If .[I6] < 0 Then 'si on veut le texte => Ecart Annuel Définitif Entre en Bleu. Si non Mettre If .[I6] > 0 Then pour le texte en rouge
.[G6] = "Ecart Annuel Définitif En Moins Entre " & An - 1 & " & " & An
.[G6].Font.ColorIndex = 3
Call Joli(.[G6], 39, 11, 5)
Call Joli(.[G6], 44, 1, 3)
Else
.[G6] = "Ecart Annuel Définitif En Plus Entre " & An - 1 & " & " & An
.[G6].Font.ColorIndex = 5
Call Joli(.[G6], 38, 11, 3)
Call Joli(.[G6], 43, 1, 5)
End If
' .Protect UserInterfaceOnly:=True, DrawingObjects:=False
End With
' Début des modifications du 16/10/2022
GestionErreur:
If Err.Number = 13 Then
MsgBox "Corriger la formule des cellules I6 & I5"
End If
' Fin des modifications du 16/10/2022
Application.EnableEvents = True
End Sub |
Ça affiche 2 fois ou 3 fois suivant l'ordre des modifications
Répondre avec citation
Partager