extraction de l'équation du label d'un graphique

La première version ne traitait pas les coef négatifs, ni les degrés
supérieur.

Voici une version jusqu'au degré 6.

Sub GetFormula()
' d'après "Tom Ogilvy", modifié pour utiliser le séparateur décimal
"virgule"
' extrait les coef d'une équation jusqu'au degré 6 (à partir du label
du graphique)
' le coeficient supérieur est en N6 (coef du degré inférieur en
dessous etc.) et degré en O6
' ATTN : le range ("N6:O12") est utilisé pour une équation de degré 6
Dim sStr As String, sStr1 As String, sStr2 As String
Dim sFormula As String, j As Long
Dim i As Long
Dim ser As Series, sChar As String
Dim tline As Trendline
Dim cht As Chart
Dim rng As Range
Dim varr()
ReDim varr(1 To 7, 1 To 2)
Set cht = ActiveSheet.ChartObjects(1).Chart
For Each ser In cht.SeriesCollection
If ser.Trendlines.Count = 1 Then
Set tline = ser.Trendlines(1)
If tline.DisplayEquation Then
sFormula = tline.DataLabel.Text '<== this gets the
formula
sFormula = Application.Substitute(sFormula, "y = ", "")
sFormula = Application.Substitute(sFormula, ",", ".")
sFormula = Application.Substitute(sFormula, " + ", ",")
sFormula = Application.Substitute(sFormula, " - ", ",-")
'Debug.Print sFormula
j = 1
For i = 1 To Len(sFormula) + 1
sChar = Mid(sFormula, i, 1)
If sChar = "," Or i = Len(sFormula) + 1 Then
If i = Len(sFormula) + 1 Then
sStr1 = sStr1 & sChar
End If
varr(j, 1) = sStr1
varr(j, 2) = sStr2
'Debug.Print j; varr(j, 1); varr(j, 2)
sStr1 = ""
sStr2 = ""
j = j + 1
Else
If sChar <> "x" Then
sStr1 = sStr1 & sChar
Else
If Mid(sFormula, i + 1, 1) <> "," Then
sStr2 = sStr2 & sChar & Mid(sFormula, i
+ 1, 1)
i = i + 1
Else
sStr2 = sStr2 & sChar
End If
End If
End If
Next
'Debug.Print j; varr(j - 1, 1); varr(j - 1, 2)
Set rng = Range("N6")
j = 1
For i = LBound(varr) To UBound(varr)
'Debug.Print i; varr(i, 1); varr(i, 2)
rng(j, 1) = CVar(varr(i, 1))
rng(j, 2) = CVar(varr(i, 2))
'Debug.Print j; rng(j, 1); rng(j, 2)
j = j + 1
Next i
Exit Sub
End If
End If
Next
End Sub

Bonsoir,

Par un beau dimanche de difficultés... je sollicite votre aide pour
supprimer une erreur 13 dans cette macro de Tom Ogilvy.

La sub() extrait les équations inscritent dans les labels d'un graphique.
Je ne maitrise pas les tableaux, si une pointure pouvait supprimer
cette erreur, j'en serais moult reconnaissant.

C'est à la fin sur cette ligne :
rng(j).Value = val(varr(i))

Merci pour l'aide

fetnat

Sub GetFormula()
'"Tom Ogilvy"
Dim sStr As String, sStr1 As String
Dim sFormula As String, j As Long
Dim i As Lon
Dim ser As Series, sChar As String
Dim tLine As Trendline
Dim cht As Chart
Dim rng As Range
Dim varr()
ReDim varr(1 To 10)
Set cht = ActiveSheet.ChartObjects(1).Chart
For Each ser In cht.SeriesCollection
If ser.Trendlines.Count = 1 Then
Set tLine = ser.Trendlines(1)
If tLine.DisplayEquation Then
sFormula = tLine.DataLabel.Text '<== this gets the
formula
sFormula = Application.Substitute(sFormula, _
"y = ", "")
sFormula = Application.Substitute(sFormula, _
" + ", ",")
'Debug.Print sFormula
j = 1
For i = 1 To Len(sFormula)
sChar = Mid(sFormula, i, 1)
If sChar = "," Or i = Len(sFormula) Then
If i = Len(sFormula) Then
sStr1 = sStr1 & sChar
End If
varr(j) = sStr1
sStr1 = ""
j = j + 1
Else
sStr1 = sStr1 & sChar
End If
Next
ReDim Preserve varr(1 To j - 1)
Set rng = Range("N6")
j = 1
For i = LBound(varr) To UBound(varr)
rng(j).Value = val(varr(i))
j = j + 1
Next i
Exit Sub
End If
End If
Next
End Sub