Private Sub Worksheet_Calculate()
If Not CommandButton1.Caption Like "Annuler*" Then Exit Sub
Dim sep$, c As Range, t, i%, flag As Boolean, x$, j%, xtemp$, k%
Dim cf$, nblig&, nbcol%, y As Variant, z$
sep = "=()+-*/^&!" & Application.International(xlListSeparator)
Application.ScreenUpdating = False
Cells.ClearComments 'RAZ
For Each c In Me.UsedRange
If c.HasFormula Then
t = c.FormulaLocal
For i = Len(t) To 2 Step -1
If Not flag Then If Mid(t, i, 1) = """" Then flag = True: i = i - 1
If flag Then If Mid(t, i, 1) = """" Then flag = False
If Not flag And InStr(sep, Mid(t, i + 1, 1)) Then
x = ""
For j = i To 1 Step -1
If InStr(sep, Mid(t, j, 1)) Then
xtemp = Mid(t, j + 1, i - j)
If TypeName(Evaluate(xtemp)) = "Range" Then _
If Evaluate(xtemp).Count = 1 Then x = xtemp
If Mid(t, j, 1) = "!" Then
If Mid(t, j - 4, 5) = "#REF!" Then i = j - 4: GoTo 1 'si feuille supprimée
If Mid(t, j - 5, 6) = "#REF'!" Then i = j - 5: GoTo 1 'd° autre classeur
x = "" 'efface le x précédent
For k = j - 1 To 2 Step -1
If Mid(t, k, 1) = "\" Then 'autre classeur fermé
While Mid(t, k, 1) <> "'": k = k - 1: Wend
x = Mid(t, k, i - k + 1): j = k - 1
cf = Application.ConvertFormula(x, xlA1, xlR1C1)
nblig = 1: nbcol = 1
On Error Resume Next 'si la référence est un nom qui a été supprimé
nblig = ExecuteExcel4Macro("ROWS(" & cf & ")")
nbcol = ExecuteExcel4Macro("COLUMNS(" & cf & ")")
On Error GoTo 0
If nblig * nbcol > 1 Then i = j: GoTo 1
y = ExecuteExcel4Macro(cf)
z = CStr(y)
If IsNumeric(y) Then z = UCase(z) 'pour les valeurs logiques
If IsError(y) Then z = "<" & z & ">"
GoTo 2
Else
xtemp = Mid(t, k, i - k + 1)
If TypeName(Evaluate(xtemp)) = "Range" Then _
If Evaluate(xtemp).Count = 1 Then x = xtemp: j = k - 1
End If
Next k
End If
If x <> "" Then
y = Evaluate(x): z = Evaluate(x).Text
2 z = IIf(IsNumeric(y) Or IsError(y), z, """" & z & """")
t = Left(t, j) & z & Mid(t, i + 1)
End If
i = j
Exit For
End If
Next j
End If
1 Next i
Me.Activate
c.AddComment t: c.Comment.Shape.TextFrame.AutoSize = True: c.Comment.Visible = True
End If
Next c
End Sub
