Macro pour modifier les données d'un graph ?
Bonjour à tous,
Avant tout je tiens à préciser que j'ai fait des longues heures de recherches et que j'ai chercher moi-même à résoudre mon problème sans succes.
Je cherche à créer une macro qui viendra modifier automatiquement les données d'un graphique selon un critère choisi depuis une liste déroulante.
Je vous explique :
J'ai un tableau de recette, avec en en-tête le nom de la recette à choisir et cela affiche dans le tableau les composant. Le graphique lui affiche sous forme de barre les différents composants.
J'ai réussi à programmer la macro et je l'ai affecté à un bouton, ça marche bien. Le seul problem c'est qu'il créer un nouveau graphique à chaque fois et le fichier deviant très vite encombré.
J'ai donc essayer d'appliquer ma macro afin qu'il fasse juste la modification sur le graphique existant et là ça coince ! j'ai eu droit à different message de bug.
Je vous met en PJ un exemple pour mieux comprendre et voice mon code VBA :
Sub CreationGraphique()
'
' CreationGraphique Macro
'
'
If Range("D15") = "Joe" Or (Range("D15") = "Zoe") Or (Range("D15") = "Foe") Or (Range("D15") = "Noe") Or (Range("D15") = "Koe") Then
ActiveSheet.Shapes.AddChart2(216, xlBarClustered).Select
ActiveChart.FullSeriesCollection(1).Name = "=Feuil1!$D$15"
ActiveChart.FullSeriesCollection(1).Values = "=Feuil1!$D$16:$D$17"
ActiveChart.FullSeriesCollection(1).XValues = "=Feuil1!$C$16:$C$17"
End If
If Range("D15") = "Boe" Or (Range("D15") = "Doe") Or (Range("D15") = "Soe") Then
ActiveSheet.Shapes.AddChart2(216, xlBarClustered).Select
ActiveChart.FullSeriesCollection(1).Name = "=Feuil1!$D$15"
ActiveChart.FullSeriesCollection(1).Values = "=Feuil1!$D$16:$D$19"
ActiveChart.FullSeriesCollection(1).XValues = "=Feuil1!$C$16:$C$19"
End If
If Range("D15") = "Loe" Then
ActiveChart.SeriesCollection.NewSeries
ActiveChart.FullSeriesCollection(1).Name = "=Feuil1!$D$15"
ActiveChart.FullSeriesCollection(1).Values = "=Feuil1!$D$20:$D$21"
ActiveChart.FullSeriesCollection(1).XValues = "=Feuil1!$C$20:$C$21"
End If
End Sub
J'aimerai donc qu'il fasse la modification automatiquement pour chaque element selectionné et qu'il n'affiche que la composition qui le concerne
merci pour votre aide
Bonjour,
Essaie ainsi :
Sub Create_Chart()
Dim ws As Worksheet
Dim objchart As ChartObject
Dim rCell As Range
Dim sr As Series
Dim nm As String, X As String, Y As String
Application.ScreenUpdating = False
Set ws = ActiveSheet
With ws
Set rCell = .Cells(14, 6)
On Error Resume Next
.ChartObjects(1).Delete
On Error GoTo 0
nm = Cells(15, 4).Value
Select Case nm
Case "Joe", "Zoe", "Foe", "Noe", "Koe"
X = "$C$16:$C$17": Y = "$D$16:$D$17"
Case "Boe", "Doe", "Soe"
X = "$C$16:$C$19": Y = "$D$16:$D$19"
Case "Loe"
X = "$C$20:$C$21": Y = "$D$20:$D$21"
End Select
Set objchart = .ChartObjects.Add(Left:=rCell.Left, Top:=rCell.Top, Width:=400, Height:=200)
End With
With objchart.Chart
.ChartType = xlBarClustered
Set sr = .SeriesCollection.NewSeries
With sr
.Name = nm
.Values = ws.Range(Y)
.XValues = ws.Range(X)
End With
End With
End Sub