Suite Macro pour graph avec trendlines de la meme couleurs que les points

[JuniorExcel]

Bonjour le forum, bonjour mromain

Je souhaiterais vous poser encore une question à propos de graphe géré avec VBA.

COmme rappel voici mon exemple: j ai des données comme ceci par example
A 1 1
A 2 2
A 3 3
B 1 4
B 2 6
C 1 5

Et grace a mromain j'ai la maco ci-dessous qui marche tres bien.

J'ai juste rajouté les lignes en rouge car j aimerai que pour les points de chaque series, le graphes fasse automatiquement des trendlines. Ceci marche mais elles sont toutes en noires. Seulement pour que ça soit plus lisible il faudrait qu'elles aient la meme couleur que leur series de points .... Savez-vous comment faire?


Merci !

--------------------------------------------------------------------------

Sub Test()
Dim graphXY As Chart, nouvSerie As Series, i As Long, cpt As Long, feuilSource As Worksheet, zoneGraphique As Range
Dim tabSeries() As Variant, dicoSeries As Object, nbSeries As Long, nbPts As Long, tabValX() As Double, tabValY() As Double, derLig As Long, zoneSeries As Range, cellR As Range, memAdr As String

'initialiser les variables
Set feuilSource = ThisWorkbook.Sheets("Data")
Set zoneGraphique = feuilSource.Range("F20:M35")

'récupérer la liste des séries (colonne A)
derLig = feuilSource.Cells(feuilSource.Rows.Count, 1).End(xlUp).Row
Set dicoSeries = CreateObject("Scripting.Dictionary")
On Error Resume Next
For i = 2 To derLig
dicoSeries.Add feuilSource.Cells(i, 1).Text, feuilSource.Cells(i, 1).Text
Next i
On Error GoTo 0
tabSeries = dicoSeries.Items

'créer un nouveau graphique (de type XY Scatter)
With zoneGraphique
Set graphXY = .Parent.ChartObjects.Add(.Left, .Top, .Width, .Height).Chart
End With
graphXY.ChartType = xlXYScatter

Set zoneSeries = feuilSource.Range(feuilSource.Cells(2, 1), feuilSource.Cells(derLig, 1))
'boucler sur chaque série
For i = LBound(tabSeries) To UBound(tabSeries)

'récupérer les points de la série
nbPts = WorksheetFunction.CountIf(zoneSeries, tabSeries(i))
ReDim tabValX(1 To nbPts)
ReDim tabValY(1 To nbPts)
cpt = 0
Set cellR = zoneSeries.Find(tabSeries(i), , xlValues, xlWhole)
If Not cellR Is Nothing Then
memAdr = cellR.Address
Do
cpt = cpt + 1
tabValX(cpt) = cellR.Offset(0, 1).Value
tabValY(cpt) = cellR.Offset(0, 2).Value
Set cellR = zoneSeries.FindNext(cellR)
Loop Until cellR.Address = memAdr
End If

'ajouter la série au graphique
Set nouvSerie = graphXY.SeriesCollection.NewSeries
nouvSerie.Name = tabSeries(i)
nouvSerie.XValues = tabValX
nouvSerie.Values = tabValY
With nouvSerie.Trendlines
.Add Type:=xlLogarithmic
End With
Next i

End Sub

 

[JuniorExcel]

Re : Suite Macro pour graph avec trendlines de la meme couleurs que les points

en faite j ai trouvé il faut rajouter:

With nouvSerie.Trendlines(1)
.Border.ColorIndex = i
End With


si jamais qqun a un probleme de ce type un jour.

Par contre je cherche comment enlever la legende de ces trendlines car soit ça m enleve toute les legendes soit j'ai celles des series et celles des trendlines... si jamais qqun a une idee....

Merci