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

R

RFL131

Nouveau membre
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 :
Code: 
    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.
 
zeb

zeb

Modérateur
Salut,

Utilise des variables et des objets bien identifiés, ce que ne peut pas faire l'enregistreur de macros.
Code: 
Set ma_serie = mon_chart.SeriesCollection.NewSeries

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

Code: 
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 :
Code: 
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 ?
 
R

RFL131

Nouveau membre
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

Code: 
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
 
R

RFL131

Nouveau membre
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 !
 
R

RFL131

Nouveau membre
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...
Code: 
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

zeb

Modérateur
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 :/
 
R

RFL131

Nouveau membre
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
Code: 
Count
que tu m'as proposé pour les incrémenter puisqu'à chaque nouvel indice j'utilise la méthode
Code: 
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
 
R

RFL131

Nouveau membre
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
Code: 
"" & ""
Code:
:
Code: 
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
 
R

RFL131

Nouveau membre
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 "
Code: 
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...
 
R

RFL131

Nouveau membre
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 :
Code: 
ma_feuil = "SECT 06000"
après ça je ne peux pas attribuer un nom à une valeur de la cellule de "ma_feuil" comme ça ?
Code: 
actu = ma_feuil.Cells(1 + i, 3).Value
 
zeb

zeb

Modérateur
Moderator dixit : utilise la balise
Code: 
 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

zeb

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

Code: 
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).

Code: 
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
 
zeb

zeb

Modérateur
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 ;) )
 
R

RFL131

Nouveau membre
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...
 
R

RFL131

Nouveau membre
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
Code: 
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
 
R

RFL131

Nouveau membre
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 ...
 
R

RFL131

Nouveau membre
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

Code: 
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
 
R

RFL131

Nouveau membre
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

Code: 
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
 
zeb

zeb

Modérateur
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 :

Code: 
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 ;)
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Dernières actus
Derniers messages publiés
Statistiques globales
Discussions
730 128
Messages
6 717 843
Membres
1 586 372
Dernier membre
Meeithot
Partager cette page
Haut