Macro pour créer un grand nombre de séries automatiquement dans un graphe

RFL131

31 Janvier 2013 15:45:25

Bonjour,
J'ai eu beau chercher et avoir lu les sujets qui abordaient cette question sur le forum, je n'ai pas trouvé la réponse à mon incompétence en macro, j'ai pris soin de bien regarder l'aide VBA, mais j'avoue avoir atteint mon niveau de Peters en vba...
Bref, j'ai une liste de points que je souhaite ajouter comme droites sur un graphique existant. Chaque couple de points - stockés par ligne mais dans les mêmes colonnes - me permettent de définir une droite. J'ai plusieurs onglets, dont chacun a un nombre de lignes différent.

Voici ce que j'ai créé pour le moment avec l'enregistreur :

ActiveChart.ChartArea.Select

    ActiveChart.SeriesCollection.NewSeries

    ActiveChart.SeriesCollection(6).XValues = _

        "=('S60'!R2C3,'S60'!R2C14)"

    ActiveChart.SeriesCollection(6).Values = _

        "=('S60'!R2C4,'S60'!R2C15)"

    ActiveChart.SeriesCollection(6).Name = "='S60'!R2C1"

    ActiveChart.SeriesCollection(6).Border.ColorIndex = 6

    ActiveChart.SeriesCollection(6).MarkerStyle = none

    ActiveChart.Legend.LegendEntries(4).Delete

j'ai réussi pour le moment à faire une droite pour un couple de points bien définis de la couleur qui me va bien (tjs la même) et sans ajouter de légende, le problème est de faire de ce code une boucle (sur les lignes), j'ai essayé de récupérer le nombre de lignes pour y arriver, mais je suis un peu limité pour y arriver seul.

Je suis prêt à relancer à chaque fois la macro dans les différents onglets de mon classeur pour simplifier.

D'avance merci de votre aide.

Autres pages sur : macro creer grand nombre series automatiquement graphe

| Etre averti des réponses
| Alerter

Répondre à RFL131

zeb

31 Janvier 2013 16:44:53

Salut,

Utilise des variables et des objets bien identifiés, ce que ne peut pas faire l'enregistreur de macros.

Set ma_serie = mon_chart.SeriesCollection.NewSeries

Tu t'affranchis ensuite d'avoir à connaître son numéro.

ma_serie.XValues = "('S60'!R2C3,'S60'!R2C14)"
ma_serie.Values = "('S60'!R2C4,'S60'!R2C15)"

Sauf si bien sûr tu en as besoin pour établir les autres paramètres.
Mais même dans ce cas, il est plus intéressant de récupérer ce compteur, comme ça :

nb_series = mon_chart.SeriesCollection.Count
mon_adresse_de_cellule = "S" & nb_series &"0";
ma_serie.Values = "('" & mon_adresse_de_cellule & "'!R2C4,'" & mon_adresse_de_cellule & "'!R2C15)"

Mettre tout ça dans une boucle devrait maintenant être plus facile, non ?

| Alerter

Répondre à zeb

RFL131

31 Janvier 2013 16:53:46

J'avance... j'ai réussi à faire une boucle avec un arrêt quand la cellule de la colonne C est vide pour une ligne donnée en partant du principe que je n'aurai pas plus de 300 pts à rentrer, mon problème reste d'affecter les valeurs avec des variables et la fonction Offset pour les coordonnées du graphique

Sub BATONNETS()
'
' BATONNETS Macro
    ActiveChart.ChartArea.Select
For i = 1 To 300
actu = Cells(1 + i, 3).Value
    If actu <> "" Then
'    Cells(1 + i, 3).Offset(0, 25).Value = 3
    ActiveChart.SeriesCollection.NewSeries
    vals1 = "=(actu)"
    ActiveChart.SeriesCollection(6).XValues = _
       "=(actu,'S60'!R2C14)"
    ActiveChart.SeriesCollection(6).Values = _
       "=('S60'!R2C4,'S60'!R2C15)"
    ActiveChart.SeriesCollection(6).Name = "='S60'!R2C1"
    ActiveChart.SeriesCollection(6).Border.ColorIndex = 6
    ActiveChart.SeriesCollection(6).MarkerStyle = none
   ActiveChart.Legend.LegendEntries(4).Delete
 
    Else
    End If
Next i
End Sub

zeb a édité ce message 31 Janvier 2013 17:37:37

| Alerter

Répondre à RFL131

RFL131

31 Janvier 2013 16:57:45

Merci zeb pour ta réponse j'avance et ta remarque va m'aider. J'avais essayé d'utiliser la propriété Count notamment pour supprimer la série dans la légende mais sans supprimer son nom, mais bizarrement je n'ai pas réussi, il semble que ma version d'excel ne connait pas "LegendEntries.Count" ou alors je n'ai pas compris la syntaxe...
la 2ème hypothèse est plus probable malheureusement !

| Alerter

Répondre à RFL131

RFL131

31 Janvier 2013 17:39:25

bon j'avance... ou pas
je bloque sur l'affectation de la valeur de la cellule (i+1,C), ça marchait tant que je ne cherchais pas à utiliser le nom de la feuille active, et là iln veut plus la méthode ne fonctionne pas avec _Global, l'aide vba sur les erreurs ne m'aide pas... si vous avez une indication à me donner sur ce que je n'ai pas compris au niveau des affectations, je suis preneur...

Sub BATONNETS()
'
' BATONNETS Macro
nom = ActiveSheet.Name
For i = 1 To 300
actu = Cells(1 + i, 3).Value
If actu <> "" Then
ActiveChart.ChartArea.Select
Set newseri = ActiveChart.SeriesCollection.NewSeries
newseri.XValues = "('" & nom & "'!R" & 1 + i & "C3, '" & nom & "'!R" & 1 + i & "C14)"
ActiveChart.SeriesCollection(6).Values = "('" & nom & "'!R" & 1 + i & "C4, '" & nom & "'!R" & 1 + i & "C15)"
ActiveChart.SeriesCollection(6).Name = "='" & nom & "'!R" & 1 + i & "C1"
ActiveChart.SeriesCollection(6).Border.ColorIndex = 6
ActiveChart.SeriesCollection(6).MarkerStyle = none
ActiveChart.Legend.LegendEntries(4).Delete
Else
End If
Next i
End Sub

zeb a édité ce message 1 Février 2013 08:41:56

| Alerter

Répondre à RFL131

zeb

31 Janvier 2013 17:40:08

Si tu ne daignes pas mettre en place ou au mois essayer ce que je te propose, je vais me désintéresser de ton cas

| Alerter

Répondre à zeb

RFL131

31 Janvier 2013 17:51:31

bah si j'ai mis en œuvre une partie de ce que tu m'as dit j'ai affecté un nom newseri à ma série (j'ai bien compris compris que Select c'est "sale" et tu noteras que je n'en avais pas trace dès le départ !
mais je n'ai a priori pas besoin du compteur

Count

que tu m'as proposé pour les incrémenter puisqu'à chaque nouvel indice j'utilise la méthode

SeriesCollection.NewSeries

, d'autant que je veux que chaque série porte un nom spécifique qui est dans la première colonne
une remarque : tu me proposes de donner des noms avec "S" index "0" mais le "S60" est le nom de la feuille, pas de ma série

| Alerter

Répondre à RFL131

RFL131

31 Janvier 2013 17:54:35

bon ok en regardant mon code ce n'était pas évident d'autant que je n'ai pas modifié la fin vu que je bute sur le début, avec tes conseils voici à quoi ça ressemble, tu noteras également que j'ai tenté d'utiliser ton adressage (le terme est-il bon ?) avec les

"" & ""

:

Sub BATONNETS()
'
' BATONNETS Macro
ActiveChart.ChartArea.Select
For i = 1 To 300
actu = Cells(1 + i, 3).Value
If actu <> "" Then
nom = "SECT 06000"
Set newseri = ActiveChart.SeriesCollection.NewSeries
newseri.XValues = "('" & nom & "'!R" & 1 + i & "C3, '" & nom & "'!R" & 1 + i & "C14)"
newseri.Values = "('" & nom & "'!R" & 1 + i & "C4, '" & nom & "'!R" & 1 + i & "C15)"
newseri.Name = "='" & nom & "'!R" & 1 + i & "C1"
newseri.Border.ColorIndex = 6
newseri.MarkerStyle = none
ActiveChart.Legend.LegendEntries(4).Delete
Else
End If
Next i
End Sub

| Alerter

Répondre à RFL131

RFL131

31 Janvier 2013 18:01:44

en fait, si je continue dans ta démarche d'attribuer des noms aux objets pour faciliter les actions, il faudrait que je récupère le nom de mon graphe pour qu'il soit actif, parce qu'avec ce que j'ai fait :
1. soit j'ai une cellule de ma feuille sélectionnée au moment où je lance ma macro et il peut faire le test avec "actu'" mais il bloque sur la ligne "

activeChart...

"
2. soit je sélectionne mon graphe au début et les lignes qui concernent la nouvelle série newseri et les attributions de valeurs semblent fonctionner, mais il bloque bien avant sur le test avec "actu parce qu'il ne sait pas la chercher...

| Alerter

Répondre à RFL131

RFL131

31 Janvier 2013 18:27:11

pfff... je pense qu'il y a une subtilité dans le type d'objets que je manipule qui ne devraient pas avoir la même syntaxe

j'ai donné un nom à ma feuille :

ma_feuil = "SECT 06000"

après ça je ne peux pas attribuer un nom à une valeur de la cellule de "ma_feuil" comme ça ?

actu = ma_feuil.Cells(1 + i, 3).Value

| Alerter

Répondre à RFL131

zeb

1 Février 2013 08:43:13

Moderator dixit : utilise la balise [code=vb] plutôt que [code=actionscript]

Et intente ton code, bordel ! Tu en profiteras pour supprimer le rappel de la variable après le Next
Et vire la clause Else !

zeb a édité ce message 1 Février 2013 08:46:43

| Alerter

Répondre à zeb

zeb

1 Février 2013 09:03:53

Il ne faut pas confondre la feuille et le nom de la feuille !

Dim ma_feuille As Worksheet
Dim mon_nom_de_feuille As String
 
mon_nom_de_feuille = "SECT 6000"
Set ma_feuille = Worksheets(mon_nom_de_feuille)
 
MsgBox "La valeur de la cellule C" & (1 + i) & " est : " & ma_feuille.Cells(1 + i, 3).Value

On a la même chose avec les cellules et leur valeur (et leurs autres attributs).

Dim ma_cellule As Range ' // Il n'y a pas de type Cell en VBA/Excel ! Range c'est plusieurs cellules
Dim ma_valeur As Variant
 
Set ma_cellule = Worksheets.Cells(1 + i, 3)
ma_valeur = ma_cellule.Value

| Alerter

Répondre à zeb

zeb

1 Février 2013 09:05:35

Bon, t'en es où ?
Comme je pense que tu as bien avancé, je te propose de faire un point et de voir ce que je peux t'apporter.
(Je ne m'en lasserai pas

)

| Alerter

Répondre à zeb

RFL131

1 Février 2013 09:32:02

salut zeb
désolé, réunions... je m'y remets cet après-midi, promis je vais faire des efforts de mise en forme également, et tes remarques vont me servir, ça me rappelle des notions sur les objets, oups c'est loin tout ça...

| Alerter

Répondre à RFL131

RFL131

1 Février 2013 16:13:17

Bon, avec tes dernières indications, je croyais que j'y arriverais seul, mais encore une fois je sous-estimait l'étendue de mes incompétences dans la gestion des différences entre objets, propriétés, etc...

bon voici ce que j'ai fait je suis pas sûr que la suite soit bonne non plus, mais pour le moment je bute sur la ligne qui est en commentaire "mon_chart...", le message d'erreur, que j'ai beau essayer d'interpréter est "variable objet ou variable de bloc non définie" je me dis que l'objet "ChartObjects(1)" n'est pê pas un graphe, mais je crois n'avoir que ça dans ma feuille comme Chartobjects, mais je ne sais pas comment lui faire afficher la liste des chartobjets ce qui me permettrait de l'appeler directement par son nom...
c'est bon là le format de code ? je n'ai pas vu vba dans la liste déroulante

Sub BATONNETS()
 
' hyp. sélection graphe au début
Dim ma_feuille As Worksheet
Dim mon_nom_de_feuille As String
Dim ma_cellule As Range
Dim ma_valeur As Variant
Dim mon_chart As ChartObject
 
    Message = "Entrer le nom de l'onglet à traiter"
    Title = "Onglet à traiter"
    mon_nom_de_feuille = InputBox(Message, Title)
    Set ma_feuille = Worksheets(mon_nom_de_feuille)
 
    For i = 1 To 300
        Set ma_cellule = ma_feuille.Cells(1 + i, 3)
        ma_valeur = ma_cellule.Value
            If ma_valeur <> "" Then
            MsgBox ma_feuille.ChartObjects(1)
                'mon_chart = ma_feuille.ChartObjects(1).Chart.ChartArea.Select
                Set newseri = ActiveChart.SeriesCollection.NewSeries
                newseri.XValues = "('" & ma_feuille & "'!R" & 1 + i & "C3, '" & ma_feuille & "'!R" & 1 + i & "C14)"
                newseri.Values = "('" & ma_feuille & "'!R" & 1 + i & "C4, '" & ma_feuille & "'!R" & 1 + i & "C15)"
                newseri.Name = "='" & ma_feuille & "'!R" & 1 + i & "C1"
                newseri.Border.ColorIndex = 6
                newseri.MarkerStyle = none
                ActiveChart.Legend.LegendEntries(4).Delete
            ' il y a déjà 3 courbes dans ma légende au momen où je lance ma macro
            End If
    Next i
End Sub

RFL131 a édité ce message 1 Février 2013 16:16:52

| Alerter

Répondre à RFL131

RFL131

1 Février 2013 17:56:00

ouhou punaise je me rends compte que c'est très con ce que j'ai écris, ne m'abandonne pas pour autant zeb ! hein ...

| Alerter

Répondre à RFL131

RFL131

4 Février 2013 13:25:06

Bon après plusieurs tentatives, je m'avoue vaincu.
voici ce vers quoi je tendais, mais mes tentatives de définir un range n'aboutissent pas... le problème est que je n'arrive pas à définir un range pour la ligne où je définis newseri.XValues

pourtant je suis bien allé voir l'aide qui dit que la propriété cells "renvoie un objet Range qui représente les cellules contenues dans la plage spécifiée"...

si quelqu'un a une idée pour m'aider, merci d'avance

Sub BATONNETS()
 
' hyp. sélection graphe au début
Dim ma_feuille As Worksheet
Dim mon_nom_de_feuille As String
Dim ma_cellule, ma_cellule1, ma_cellule2, ma_cellule3, ma_cellulex, ma_celluley As Range
Dim ma_valeur As Variant
Dim newseri As Series
 
    Message = "Entrer le nom de l'onglet à traiter"
    Title = "Onglet à traiter"
    mon_nom_de_feuille = InputBox(Message, Title)
    Set ma_feuille = Worksheets(mon_nom_de_feuille)
 
    For i = 1 To 300
        Set ma_cellule = ma_feuille.Cells(1 + i, 3)
        ma_valeur = ma_cellule.Value
            If ma_valeur <> "" Then
            Set ma_cellule1 = ma_feuille.Cells(1 + i, 14)
            Set ma_cellule2 = ma_feuille.Cells(1 + i, 4)
            Set ma_cellule3 = ma_feuille.Cells(1 + i, 15)
            Set ma_cellulex = Union(ma_cellule, ma_cellule1)
            Set ma_celluley = Union(ma_cellule2, ma_cellule3)
                Set newseri = ActiveChart.SeriesCollection.NewSeries
                newseri.XValues = ma_cellulex
                newseri.Values = ma_celluley
                newseri.Name = "='" & mon_nom_de_feuille & "'!R" & 1 + i & "C1"
                newseri.Border.ColorIndex = 6
                newseri.MarkerStyle = none
                ActiveChart.Legend.LegendEntries(4).Delete
            End If
    Next i
End Sub

| Alerter

Répondre à RFL131

RFL131

4 Février 2013 14:43:26

bon, j'ai fini pas y arriver, en trichant mais j'avoue ne pas avoir bien compris ce qui me posait problème, même si ça provenait forcément de la manière dont je faisais les affectations des objets, etc.
j'ai mis mes valeurs dans des colonnes adjacentes pour pouvoir définir facilement les "range" (vu qu'au départ c'était des colonnes disjointes) et j'ai triché en sélectionnant le graphe avant de lancer ma macro, ça fonctionne
merci pour les indications

Sub BATONNETS()
 
Dim ma_feuille As Worksheet
Dim mon_nom_de_feuille As String
Dim ma_cellule As Range
Dim ma_valeur As Variant
Dim newseri As Series
 
    Message = "Entrer le nom de l'onglet à traiter"
    Title = "Onglet à traiter"
    mon_nom_de_feuille = InputBox(Message, Title)
    Set ma_feuille = Worksheets(mon_nom_de_feuille)
 
    For i = 1 To 300
        Set ma_cellule = ma_feuille.Cells(1 + i, 3)
        ma_valeur = ma_cellule.Value
            If ma_valeur <> "" Then
                Set newseri = ActiveChart.SeriesCollection.NewSeries
                newseri.XValues = Range(ma_feuille.Cells(1 + i, 27), ma_feuille.Cells(1 + i, 28))
                newseri.Values = Range(ma_feuille.Cells(1 + i, 29), ma_feuille.Cells(1 + i, 30))
                newseri.Name = "='" & mon_nom_de_feuille & "'!R" & 1 + i & "C1"
                newseri.Border.ColorIndex = 6
                newseri.MarkerStyle = none
                ActiveChart.Legend.LegendEntries(4).Delete
            ' il y a déjà 3 courbes dans ma légende au moment où je lance ma macro
            End If
    Next i
End Sub

| Alerter

Répondre à RFL131

zeb

12 Février 2013 16:36:23

Bon, je t'avais oublié - et tout le reste du forum, soit dit en passant...
Alors, c'est pas mal ça !

J'ai repris ton code et ça donne ça :

Option Explicit
 
Sub BATONNETS_revu()
    Dim ws As Worksheet
    Dim ma_feuille As Worksheet
    Dim mon_nom_de_feuille As String
    Dim ma_ligne As Range
    Dim ma_serie As Series
    Dim mon_graphe As ChartObject
 
    Set ma_feuille = Nothing
    ' mon_nom_de_feuille = InputBox("Entrer le nom de l'onglet à traiter", "Onglet à traiter")
    mon_nom_de_feuille = "Feuil1"
    For Each ws In Worksheets
        If ws.Name = mon_nom_de_feuille Then
            Set ma_feuille = Worksheets(mon_nom_de_feuille)
            Exit For
        End If
    Next
 
    If ma_feuille Is Nothing Then
        MsgBox "Feuille inconnue !" & vbCrLf & "Procédure interrompue.", vbCritical
        Exit Sub
    End If
    If ma_feuille.ChartObjects.Count <> 1 Then
        Dim message_erreur As String
        If ma_feuille.ChartObjects.Count = 0 Then message_erreur = "Il n'y a pas de" Else message_erreur = "Il y a plus d'un"
        MsgBox message_erreur & " graphe sur cette feuille !" & vbCrLf & "Procédure interrompue.", vbCritical
        Exit Sub
    End If
    Set mon_graphe = ma_feuille.ChartObjects(1)
 
    For Each ma_ligne In Intersect(ma_feuille.Range(ma_feuille.Rows(2), ma_feuille.Rows(ma_feuille.Rows.Count)), _
                                   ma_feuille.Range("C1").CurrentRegion.EntireRow).Rows
        Set ma_serie = mon_graphe.Chart.SeriesCollection.NewSeries
        ma_serie.XValues = ma_feuille.Range(ma_ligne.Cells(27), ma_ligne.Cells(28))
        ma_serie.Values = ma_feuille.Range(ma_ligne.Cells(29), ma_ligne.Cells(30))
        ma_serie.Name = "=" & ma_feuille.Name & "!" & ma_ligne.Cells(1).Address
        ma_serie.Border.ColorIndex = 6
        ma_serie.MarkerStyle = xlMarkerStyleNone
        Do While ma_serie.Legend.LegendEntries.Count > 3
            ma_serie.Legend.LegendEntries(ma_serie.Legend.LegendEntries.Count).Delete
        Loop
    Next
End Sub

A étudier, mot à mot

zeb a édité ce message 13 Février 2013 08:33:03

| Alerter

Répondre à zeb