Créer Graphe VBA

Le 04/12/2020 à 12:32

Bonjour,

J'essaye de créer une boucle permettant de réaliser des graphes pour chacun de mes stints en fonction des deux premiers lignes.

J'ai réussi à le faire fonctionner pour des valeurs fixes pour une ligne néanmoins maintenant je veux le faire fonctionner en boucle pour le réaliser sur toutes les lignes.

capture d ecran 2020 12 04 122703

Voici mon code:

Sub Macro6()
'
' Macro6 Macro
'

'
For i = 3 To 10 Step 1

ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
ActiveChart.SetSourceData Source:=Range(i & ":" & i & ", 1:2")
Set SnapPlage = ActiveSheet.Range(Cells(17 + j, 4), Cells(31 + j, 16))
ActiveSheet.ChartObjects(i).Height = SnapPlage.Height
ActiveSheet.ChartObjects(i).Top = SnapPlage.Top
ActiveSheet.ChartObjects(i).Width = SnapPlage.Width
ActiveSheet.ChartObjects(i).Left = SnapPlage.Left
ActiveChart.ClearToMatchStyle
ActiveChart.ChartStyle = 209
ActiveSheet.ChartObjects(i).Activate
j = j + 15
Next i


End Sub

Je sais où est mon problème. Je ne sais pas comment interpréter la range du graphe avec des variables.

Ma syntaxe doit être mauvaise pour cette ligne-ci:

ActiveChart.SetSourceData Source:=Range(i & ":" & i & ", 1:2")

Je cherche ici a sélectionner la ligne i correspondant au stint (axe vertical) puis sélectionner les deux premieres lignes (axe horizontal)

Afin d'obtenir cela

capture d ecran 2020 12 04 123053

Merci de votre aide

Le 04/12/2020 à 12:52

Bonjour :)

Ton sujet m'interesse mais là tout de suite j'ai pas le temps ^^

Cependant j'ai déjà travaillé sur la création de graphiques (Pareto dans mon cas) mais je vais pouvoir te balancer un extrait de mon code (la partie pour la création du graph), tu auras comme ça une idée de la syntaxes à adopter :)

Je reviendrais vers toi plus tard ;)

99graph.xlsm (48.77 Ko)
Private Sub CreationGraphique()
    Dim Datas As Range, Accueil As Range
    Dim Graph As Chart

    '//////////CREATION DU GRAPHIQUE/////////////////////////////////////////////////////////////////////////////////////
    On Error GoTo Fin
    Set Datas = F2.UsedRange
    Set Accueil = F2.Range("F1:L19")
    Set Graph = F2.ChartObjects.Add(Accueil.Left, Accueil.Top, Accueil.Width, Accueil.Height).Chart
    '////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
    '//////////AJOUT DES DONNEES AU GRAPHIQUE////////////////////////////////////////////////////////////////////////////
    With Graph
        .SeriesCollection.NewSeries
        .FullSeriesCollection(1).XValues = F2.Range("A2:A" & Datas.Rows.Count)
        .FullSeriesCollection(1).Name = F2.Range("B1")
        .FullSeriesCollection(1).Values = F2.Range("B2:B" & Datas.Rows.Count)
        .SeriesCollection.NewSeries
        .FullSeriesCollection(2).Name = F2.Range("D1")
        .FullSeriesCollection(2).Values = F2.Range("D2:D" & Datas.Rows.Count)
    '////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
    '//////////MISE EN FORME SERIE DE DONNEE N°1/////////////////////////////////////////////////////////////////////////
        With .FullSeriesCollection(1)
            .ChartType = xlColumnClustered
            With .Format.Line
                .Visible = msoTrue
                .ForeColor.ObjectThemeColor = msoThemeColorText1
                .Weight = 0.5
            End With
            With .Format.Fill
                .Visible = msoTrue
                .ForeColor.RGB = RGB(0, 176, 240)
            End With
        End With
    '////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
    '//////////MISE EN FORME SERIE DE DONNEE N°2/////////////////////////////////////////////////////////////////////////
        With .FullSeriesCollection(2)
            .ChartType = xlLine
            .AxisGroup = 2
            With .Format.Line
                .Visible = msoTrue
                .ForeColor.RGB = RGB(255, 0, 0)
            End With
        End With
    '////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
    '//////////MISE EN FORME DU GRAPHIQUE////////////////////////////////////////////////////////////////////////////////
        .Axes(xlValue).MajorGridlines.Format.Line.Visible = msoFalse
        .Axes(xlValue, xlSecondary).Format.Line.ForeColor.ObjectThemeColor = msoThemeColorText1
        .Axes(xlCategory).Format.Line.ForeColor.ObjectThemeColor = msoThemeColorText1
        .Axes(xlValue).Format.Line.ForeColor.ObjectThemeColor = msoThemeColorText1
        .Axes(xlValue).MinimumScale = 0
        .Axes(xlValue, xlSecondary).MinimumScale = 0
        .Axes(xlValue, xlSecondary).MaximumScale = 1
        .Axes(xlValue).MaximumScale = Application.WorksheetFunction.MAX(F2.Range("B2:B" & Datas.Rows.Count))
        .ChartGroups(1).GapWidth = 0
        .SetElement (msoElementChartTitleAboveChart)
        .ChartTitle.Text = F2.Range("A1")
        .SetElement (msoElementLegendBottom)
        For i = 2 To Datas.Rows.Count
            If F2.Range("D" & i) < 0.8 Then
                With .FullSeriesCollection(1).Points(i - 1).Format.Fill
                    .ForeColor.RGB = RGB(0, 112, 192)
                    .Patterned msoPatternWideUpwardDiagonal
                End With
            Else
                Exit For
            End If
        Next i
    End With
    Exit Sub
    '////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Fin:
    MsgBox "Une erreur est survenue pendant la création du graphique.", vbCritical, "Erreur"
End Sub
Le 04/12/2020 à 13:35

Donc pour toi le code serai :

65graphtest.xlsm (24.11 Ko)
Private Sub CreationGraphique()
    Dim Datas As Range, Accueil As Range
    Dim Graph As Chart
    Dim F As Worksheet

    Set F = ThisWorkbook.Worksheets("Feuil1")
    Set Datas = F.UsedRange
    Set Accueil = F.Range("F1:L19")
    Set Graph = F.ChartObjects.Add(Accueil.Left, Accueil.Top, Accueil.Width, Accueil.Height).Chart

    With Graph
        .SeriesCollection.NewSeries
        .FullSeriesCollection(1).XValues = F.Range(F.Cells(1, 2), F.Cells(2, Datas.Columns.Count))
        .FullSeriesCollection(1).Values = F.Range(F.Cells(3, 2), F.Cells(3, Datas.Columns.Count))
        .FullSeriesCollection(1).Name = F.Range("A3")
        .ChartStyle = 209
        .ChartTitle.Text = F.Range("A1")
    End With
End Sub

En admettant que la feuilles où se trouvent les datas sont sur la feuille "Feuil1", que sur cette feuille se trouve uniquement les données à exploiter et qu'il y a uniquement le nombre de colonne qu'il faut.

Mais bon difficile sans fichier à exploiter

Le 04/12/2020 à 14:47

Merci de ton aide.

Grâce a ton code j'ai compris un petit plus le codage du graphe qui m'a permis d'avoir les premières lignes pour l'axe des abscisses.

Il me sort donc un seul graphe avec tous les stints, néanmoins il faut que je fasse en sorte qu'a chaque fois qu'il refait la boucle, il doit créer un nouveau graphe afin d'avoir un graphe pour chaque stint

image

graphe: Stint 1

graphe: Stint 2

...

De plus ma syntaxe ne doit pas être encore bonne au niveau du ChartObject j'ai du mal a comprendre ce que cela représente réellement, j'ai mis i en paramètre de chartObject en pensant qu'il crée un nouveau graphe si i change, je dois me tromper. lorsque je lance la procédure, j'ai un message d'erreur "erreur d'objet" et donc la mise en page du graphe ne ce fait pas.

Je t'envoie mon fichier simplifié.

22graphe.xlsm (16.57 Ko)
Le 04/12/2020 à 15:10

Tu devrais essayer de garder la même structure que mon code si tu veux pas te mélanger mes pinceaux

Voilà le code avec une boucle For sur toutes les lignes :

43graphe.xlsm (23.88 Ko)
Private Sub CreationGraphique()
    Dim Datas As Range, Accueil As Range
    Dim Graph As Chart
    Dim F As Worksheet
    Dim cpt As Long

    Set F = ThisWorkbook.Worksheets("Feuil1")
    Set Datas = F.UsedRange
    cpt = 0
    For i = 3 To Datas.Rows.Count
        cpt = cpt + 20
        Set Accueil = F.Range("A" & cpt + 2 & ":" & "H" & cpt * 2)
        Set Graph = F.ChartObjects.Add(Accueil.Left, Accueil.Top, Accueil.Width, Accueil.Height).Chart
        With Graph
            .SeriesCollection.NewSeries
            .FullSeriesCollection(1).XValues = F.Range(F.Cells(1, 2), F.Cells(2, Datas.Columns.Count))
            .FullSeriesCollection(1).Values = F.Range(F.Cells(i, 2), F.Cells(i, Datas.Columns.Count))
            .FullSeriesCollection(1).Name = F.Cells(i, 1)
            .ChartStyle = 209
            .ChartTitle.Text = F.Range("A1") & " - " & F.Cells(i, 1)
        End With
    Next i
End Sub
Le 04/12/2020 à 16:00

Merci beaucoup, c'est parfait j'ai juste modifié une petite erreur où les graphes suivants se superposaient entre eux. Au niveau de l'affichage du graphe, il y avait cpt*2 du coup les graphes augmentaient de tailles, graphes après graphes.

61graphe.xlsm (65.96 Ko)
Le 04/12/2020 à 17:01

Impecable alors 😊 bon week-end !

Le 05/12/2020 à 18:04

Rebonjour,

J'ai de nouveau un petit problème au sujet de mes graphes:

J'ai modifié le format de mes cellules en m:ss,000 et maintenant les graphes n'arrivent plus à lire mes valeurs

Sauriez vous comment je peux résoudre cela ? J'ai beau essayer de recréer le graphe que je veux à la main sur excel je n'y arrive même pas

Cela aurait peut etre pu m'aider pour le faire ensuite sur vba

Ps:Pas besoin de s'occuper du Module 1 avec la fonction Debogage, le Worksheet avec la fonction Graphe est la seule utile dans ce cas.

33post-traitement-course.zip (343.11 Ko)
Le 07/12/2020 à 14:19

Pour le coup j'ai bien l'impression qu'il s'agit d'un problème de format stricte dans les cellules. Regarde la démarche ci-dessous :

  1. Sélectionne la/les colonnes qui vont recevoir les données avec les centièmes
  2. Sélection du format des cellules : "Autre format numérique"
  3. Va sur "Personnalisée"
  4. Et à la place de "Standard", écrit "hh:mm:ss,000"

Cela résout-il le problème ?

Rechercher des sujets similaires à "creer graphe vba"