Création de graphique

[taupivin]

je souhaiterais réaliser un graphique en vba à partir du tableau ci joint. Je vous met le graph attendue avec.
Le nombre de lignes est variable d'où la nécessité du vba.
Voici mon code actuel (qui ne marche pas):

Sub GraphQ()
'
' création et remplissage d'un graphique
'

'
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlColumnStacked
ActiveChart.SetSourceData Source:=Range("A18")

ActiveChart.SeriesCollection(1).XValues = "='Résultats'!$B$1:$G$1"

ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(1).Name = "='Résultats'!$A$2"
ActiveChart.SeriesCollection(1).Values = "='Résultats'!$B$2:$G$2"

ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).Name = "='Résultats'!$A$3"
ActiveChart.SeriesCollection(2).Values = "='Résultats'!$B$3:$G$3"

ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(3).Name = "='Résultats'!$A$4"
ActiveChart.SeriesCollection(3).Values = "='Résultats'!$B$4:$G$4"

ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(4).Name = "='Résultats'!$A$5"
ActiveChart.SeriesCollection(4).Values = "='Résultats'!$B$5:$P$5"

ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(5).Name = "='Résultats'!$A$6"
ActiveChart.SeriesCollection(5).Values = "='Résultats'!$B$6:$P$6"

ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(6).Name = "='Résultats'!$A$7"
ActiveChart.SeriesCollection(6).Values = "='Résultats'!$B$7:$P$7"

ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(7).Name = "='Résultats'!$A$8"
ActiveChart.SeriesCollection(7).Values = "='Résultats'!$B$8:$P$8"

End Sub

Merci d'avance

 

[PMO2]

Re : Création de graphique

Bonjour,

Une piste avec l'exemple en pièce jointe.
Je me suis entièrement référé à votre feuille de données si bien que la macro fonctionne si les données partent de A1 en ayant la même structure.
A) cellule TopLeft = nom du graphique
B) 1ère ligne = les noms pour l'axe des X
C) 1ère colonne = les noms pour les séries
D) 2ème ligne jusqu'à ligne(n) et 2ème colonne jusqu'à colonne(n) = les données

Si la structure de l'ensemble des données commencent en E15 par exemple, il vous faudra changer la constante FIRST_CELLULE (cernée par des /// dans le code)
par FIRST_CELLULE="E15". Bien sûr, on peut se passer de cette constante et construire une variable String dans le code qui pourra être renseignée par programmation.
Je vous en laisse le soin.

Copiez le code suivant dans un module de code standard

'/// Constante à adapter (cellule TopLeft de la plage de données ///
Const FIRST_CELLULE As String = "A1"
'///////////////////////////////////////////////////////////////////

Sub MakeGraph()
Dim S As Worksheet
Dim CH As Chart
Dim R As Range
Dim RangeSeries As Range
Dim RangeXValues As Range
Dim RangeSource As Range
Dim i&
On Error GoTo Erreur
Set S = ActiveSheet
'### PLAGES ###
  '--- Plage source entière ---
Set R = S.Range(FIRST_CELLULE).CurrentRegion
  '--- Plage du nom des séries ---
Set RangeSeries = R.Offset(1, 0)
Set RangeSeries = RangeSeries.Resize(RangeSeries.Rows.Count - 1, 1)
  '--- Plage  du nom de l'axe des X ---
Set RangeXValues = R.Offset(0, 1)
Set RangeXValues = RangeXValues.Resize(1, RangeXValues.Columns.Count - 1)
  '--- Plage des données ---
Set RangeSource = R.Offset(1, 1)
Set RangeSource = RangeSource.Resize(RangeSource.Rows.Count - 1, RangeSource.Columns.Count - 1)

'### GRAPHIQUE ###
ActiveSheet.Shapes.AddChart.Select
Set CH = ActiveChart
  '--- Type ---
CH.ChartType = xlColumnStacked
  '--- Données ---
CH.SetSourceData Source:=RangeSource
  '--- Nom des séries ---
For i& = 1 To CH.SeriesCollection.Count
  CH.SeriesCollection(i&).Name = RangeSeries(i&, 1)
Next i&
  '--- Nom de l'axe des X ---
CH.SeriesCollection(1).XValues = RangeXValues
  '--- Titre ---
CH.SetElement (msoElementChartTitleAboveChart)
CH.ChartTitle.Text = R(1, 1)

'### FINALISATION
'--- Désactive le graphique ---
R(1, 1).Select

Erreur:
If Err <> 0 Then MsgBox "Erreur " & Err.Number & vbCrLf & Err.Description
End Sub

Faites l'essai à partir de la pièce jointe en vous positionnant préalablement sur sa feuille "test".

Cordialement.

PMO
Patrick Morange

 

[kjin]

Re : Création de graphique

Bonjour le fil
@taupivin : Tu multiplies les discussions sur un même sujet et tu ne daignes pas prendre en considération les réponses qui te sont faites ICI , ICI , ICI ...!
Même si les solutions proposées ne te satisfont pas, la moindre des correction serait de le faire savoir
A bon entendeur...
kjin

 

[PMO2]

Re : Création de graphique

Bonjour Kjin,

Je suis époustouflé de constater la pluralité des messages de Taupivin concernant la même demande. Il sème à tous vents comme "Larousse".
Merci de m'en avertir.

Cordialement.

PMO
Patrick Morange