Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim xrg As Range, formul As String, xcell, v, n&, li, co, ech, aux, i&, s, res
Cancel = True
On Error Resume Next
Set xrg = Target.Precedents
On Error GoTo 0
If xrg Is Nothing Then
If Target.HasFormula Then
s = "La cellule " & Target.Address(0, 0) & " comporte une formule sans antécédent !" & vbLf & vbLf
s = s & "Formule Initiale : " & Target.FormulaLocal & vbLf & vbLf
s = s & "Valeur Initiale : " & Target.Text
MsgBox s, vbInformation
Exit Sub
Else
s = "La cellule " & Target.Address(0, 0) & " ne comporte pas de formule !" & vbLf & vbLf
s = s & "Valeur Initiale : " & Target.Text
MsgBox s, vbInformation
Exit Sub
End If
Else
ReDim t(1 To xrg.Count, 1 To 2)
End If
For Each xcell In xrg.Cells
li = String(20, "0") & xcell.Row: co = String(20, "0") & xcell.Column
n = n + 1: t(n, 1) = li & Chr(172) & co
Next xcell
Do
ech = False
For i = 1 To n - 1
If t(i, 1) > t(i + 1, 1) Then ech = True: aux = t(i, 1): t(i, 1) = t(i + 1, 1): t(i + 1, 1) = aux
Next i
Loop Until Not ech
For i = 1 To n
s = Split(t(i, 1), Chr(172))
t(i, 1) = Val(s(0))
t(i, 2) = Val(s(1))
Next i
res = Target.FormulaLocal
For i = n To 1 Step -1
v = Cells(t(i, 1), t(i, 2)).Text
res = Replace(res, Cells(t(i, 1), t(i, 2)).Address(1, 1), " [" & v & "] ")
res = Replace(res, Cells(t(i, 1), t(i, 2)).Address(0, 1), " [" & v & "] ")
res = Replace(res, Cells(t(i, 1), t(i, 2)).Address(1, 0), " [" & v & "] ")
res = Replace(res, Cells(t(i, 1), t(i, 2)).Address(0, 0), " [" & v & "] ")
Next i
MsgBox "La cellule " & Target.Address(0, 0) & " comporte une formule avec des antécédents !" & vbLf & vbLf & _
"Formule Initiale : " & Target.FormulaLocal & vbLf & vbLf & _
"Formule [valeur] : " & res & vbLf & vbLf & _
"Résultat = " & Target.Text, vbInformation
End Sub