Private Sub Worksheet_Change(ByVal Target As Range)
Dim Decim As Range, t$, n%, p%
Set Decim = [D8] 'paramétrage du nombre de décimales
With [B8]
If Not Intersect(Target, Union(.Cells, Decim)) Is Nothing Then
Application.EnableEvents = False
On Error Resume Next
Decim = Int(Abs(Val(Decim))) 'sécurité
.NumberFormat = "@" 'format Texte
.Font.ColorIndex = xlAutomatic 'RAZ
.Value = Replace(.Value, "%", "")
If IsNumeric(.Value) Then
'---traitement de texte---
t = Trim(Replace(Replace(.Value, "+", ""), "-", ""))
n = 1
While Mid(t, n, 1) = "0": n = n + 1: Wend '0 non significatifs
t = Mid(t, n)
n = InStr(t, Mid(0.1, 2, 1)) 'position du séparateur décimal
If n = 1 Then t = 0 & t: n = 2
If n Then
For p = Application.Min(n + Decim, Len(t)) To n + 1 Step -1
If Mid(t, p, 1) > "0" Or Mid(t, p + 1, 1) > "4" Then Exit For
Next
If Mid(t, p + 1, 1) > "4" Then _
t = Left(t, p - 1) & Val(Mid(t, p, 1)) + 1 _
Else t = Left(t, p + (p = n))
End If
'---restitution---
If t = "0" Or t = "" Then
.Value = "0 %"
ElseIf Left(.Value, 1) = "-" Then
.Value = "- " & t & " %"
.Characters(1, 1).Font.Color = vbGreen
Else
.Value = "+ " & t & " %"
.Characters(1, 1).Font.Color = vbRed
End If
End If
.Select
Application.EnableEvents = True
End If
End With
End Sub