Bonjour le forum

Lorsque je fait Nouvelle Année ça affiche 2 fois "Corriger la formule des cellules I6 & I5" si c'est fait dans cet ordre
Si c'est fait dans l'ordre "Corriger la formule des cellules I5 & I6" ça affiche 3 fois


Option Explicit
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
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
' .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

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)
Call Joli(.[A1], 14, 1, 15)
Call Joli(.[A1], 15, 4)

.Range("A3").Font.ColorIndex = 1

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

Call Joli(.[A5], 1, 5)
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

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

Call Joli(.[A8], 1, 5)
Call Joli(.[A8], 29, 27, 5)
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

Call Joli(.[A108], 1, 5)
Call Joli(.[A108], 33, 5)
Call Joli(.[A108], 48, 4)

Call Joli(.[G5], 32, 5)

CelluleG6 ActiveSheet

For Each Sh In .Shapes
If Sh.TopLeftCell.Column = 7 Then
With Sh.TextFrame.Characters(Start:=51, Length:=4)
.Insert An + 1
.Font.ColorIndex = 3
.Font.Size = 16
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)
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
An = Val(Split(.Name, " ")(1))
If .[I6] < 0 Then
.[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


Merci à vous pour vos éventuels retours
Cordialement