Création Graphique en VBA

[seblob]

Bonjour à tous,
Je me permets de re-solliciter votre aide pour le problème suivant:
Je récupère des données dans une feuille excel et je les stocks dans deux tableaux sous vba.
- TabAbscisses() à 1 dimension qui contient les 12 mois de l'année
- TabOrdonnee() qui est un tableau à 2 dimension 12 colonnes et jusqu'à 20 lignes

Avec ces tableaux je veux créer un graphique en histogrammes avec les 12 mois de l'année en abscisse.
Pour la première ligne du tabOrdonnée() c'est ok, mais le problème apparaît pour les lignes suivantes. Au lieu de recommencer en janvier, mon code continue à incrémenter l'axe des abscisses.
Comment faire pour que lorsque je reviens à la première colonne du tableau TabOrdonnee() je me replace également à la première colonne du TabAbscisse() ?

Dans le fichier il y a l'exemple avec le résultat que je cherche et ce que j'obtiens.

Merci d'avance pour vos précieux conseils

 

[Oranger]

Re : Création Graphique en VBA

Bonjour,
voilà une proposition pour résoudre ton problème. Cela le résout il ?

 

[kjin]

Re : Création Graphique en VBA

Bonjour,
Une fois de plus : bannir les cellules fusionnées !!!
Note qu'un brin d'explication n'eut pas été superflu
Solution1

Option Base 1
Sub creationGraph()
Dim id$, T(), cht As ChartObject
Dim x%, col As Byte, i As Byte, j As Byte
Dim c As Range, rng As Range
x = 1
col = 20
id = UCase(InputBox("Identification du process:", "Bilan mensuel process"))
If id = "" Then Exit Sub
ReDim Preserve T(1 To 13, x)
For i = 1 To 12
    T(i + 1, 1) = MonthName(i)
Next
Set rng = Range("O8:S33")
Set c = rng.Find(id)
If Not c Is Nothing Then
    Adresse = c.Address
    Do
        x = x + 1
        ReDim Preserve T(1 To 13, 1 To x)
        T(1, x) = Cells(c.Row, 1)
        For j = 2 To 13
            T(j, x) = Cells(c.Row, col)
            col = col + 5
        Next
        col = 20
        Set c = rng.FindNext(c)
    Loop While Not c Is Nothing And c.Address <> Adresse
Else: Exit Sub
End If

With Sheets("Graphiques")
    .Range("A1").Resize(UBound(T, 2), UBound(T, 1)) = Application.Transpose(T)
    Set rng = .Range("A1:M" & UBound(T, 2))
    Set cht = .ChartObjects.Add(10, 10, 400, 300)
    With cht.Chart
        .SetSourceData Source:=rng, PlotBy:=xlRows
        .ChartType = xlCylinderColClustered
        .HasTitle = True
        .ChartTitle.Text = "Bilan mensuel process " + id
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Mois de l'année"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "kWh"
   End With
End With
End Sub

Solution 2...après ma sieste
A+
kjin

 

[seblob]

Re : Création Graphique en VBA

Bonjour Oranger,
Merci pour la réponse, mais mon problème n'est pas totalement résolu. Dans ta proposition les valeurs du tableau en mémoire sont copiées dans une feuille excel et ensuite le graphique est créer à partir de la feuille excel. J'aimerai pouvoir créer le graphique avec les valeurs du tableau qui se trouve en mémoire directement sans devoir passer par la feuille excel. Est-ce possible?
J'y arrive pour la première ligne du tableau mais pas pour les suivantes.
Merci d'avance!

 

[kjin]

Re : Création Graphique en VBA

Bonjour,
J'ai fait une grosse sieste
solution2

Option Base 1
Sub creationGraph()
Dim id$, Tm(12), Tv(12), cht As ChartObject
Dim x%, col As Byte, i As Byte, j As Byte
Dim c As Range, rng As Range
x = 0
col = 20
id = InputBox("Identification du process:", "Bilan mensuel process")
If id = "" Then Exit Sub
For i = 1 To 12
    Tm(i) = MonthName(i)
Next
Set rng = Range("O8:S33")
Set c = rng.Find(what:=id, MatchCase:=False)
If Not c Is Nothing Then
    Adresse = c.Address
    Do
        Nom = Cells(c.Row, 1)
        For j = 1 To 12
            Tv(j) = Cells(c.Row, col)
            col = col + 5
        Next
        x = x + 1
        ajout Nom, Tm(), Tv(), x
        col = 20
        Set c = rng.FindNext(c)
    Loop While Not c Is Nothing And c.Address <> Adresse
Else: Exit Sub
End If
End Sub

Sub ajout(Nom, Tm(), Tv(), x)
With Sheets("Graphiques")
    If x = 1 Then
        Set cht = .ChartObjects.Add(10, 10, 400, 300)
        cht.Name = "Graphique1"
    End If
    With .ChartObjects("Graphique1").Chart
        .SeriesCollection.NewSeries
        .SeriesCollection(x).XValues = Tm()
        .SeriesCollection(x).Values = Tv()
        .SeriesCollection(x).Name = Nom
        If x = 1 Then
            .ChartType = xlCylinderColClustered
            .HasTitle = True
            .ChartTitle.Text = "Bilan mensuel process " + id
            .Axes(xlCategory, xlPrimary).HasTitle = True
            .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Mois de l'année"
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "kWh"
        End If
    End With
End With
End Sub

A+
kjin

 

[seblob]

Re : Création Graphique en VBA

Bonjour Kjin,
Merci pour la réponse, oui effectivement les cellules fusionnées posent quelques problèmes.
Ta proposition correspond presque à ce que je souhaitait faire. Dans l'idéal j'aimerai créer le graphique sans recopier les valeur dans la feuille excel Graphique. J'aimerai prendre les données du graphique directement dans le tableau en mémoire. Est-ce possible à ton avis?
Encore merci pour les précisions.

 

[seblob]

Re : Création Graphique en VBA

Hello Kjin,
Oui merci la solution 2 correspond à ce que je souhaitais faire. Merci beaucoup. Je vais me plonger dans ton code en détail pour comprendre comment est-ce que tu as fait cela. La sieste était longue mais cela a valu la peine! Encore merci!