Se connecter avec
S'enregistrer | Connectez-vous
Votre question

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

Tags :
  • graphique
  • vba
  • macro excel
  • Programmation
Dernière réponse : dans Programmation
Partagez
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 :
  1. ActiveChart.ChartArea.Select
  2. ActiveChart.SeriesCollection.NewSeries
  3. ActiveChart.SeriesCollection(6).XValues = _
  4. "=('S60'!R2C3,'S60'!R2C14)"
  5. ActiveChart.SeriesCollection(6).Values = _
  6. "=('S60'!R2C4,'S60'!R2C15)"
  7. ActiveChart.SeriesCollection(6).Name = "='S60'!R2C1"
  8. ActiveChart.SeriesCollection(6).Border.ColorIndex = 6
  9. ActiveChart.SeriesCollection(6).MarkerStyle = none
  10. 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

a b L Programmation
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.
  1. Set ma_serie = mon_chart.SeriesCollection.NewSeries


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

  1. ma_serie.XValues = "('S60'!R2C3,'S60'!R2C14)"
  2. 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 :
  1. nb_series = mon_chart.SeriesCollection.Count
  2. mon_adresse_de_cellule = "S" & nb_series &"0";
  3. 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 ?
m
0
l
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

  1. Sub BATONNETS()
  2. '
  3. ' BATONNETS Macro
  4. ActiveChart.ChartArea.Select
  5. For i = 1 To 300
  6. actu = Cells(1 + i, 3).Value
  7. If actu <> "" Then
  8. ' Cells(1 + i, 3).Offset(0, 25).Value = 3
  9. ActiveChart.SeriesCollection.NewSeries
  10. vals1 = "=(actu)"
  11. ActiveChart.SeriesCollection(6).XValues = _
  12. "=(actu,'S60'!R2C14)"
  13. ActiveChart.SeriesCollection(6).Values = _
  14. "=('S60'!R2C4,'S60'!R2C15)"
  15. ActiveChart.SeriesCollection(6).Name = "='S60'!R2C1"
  16. ActiveChart.SeriesCollection(6).Border.ColorIndex = 6
  17. ActiveChart.SeriesCollection(6).MarkerStyle = none
  18. ActiveChart.Legend.LegendEntries(4).Delete
  19.  
  20. Else
  21. End If
  22. Next i
  23. End Sub
m
0
l
Contenus similaires
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 !
m
0
l
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...
  1. Sub BATONNETS()
  2. '
  3. ' BATONNETS Macro
  4. nom = ActiveSheet.Name
  5. For i = 1 To 300
  6. actu = Cells(1 + i, 3).Value
  7. If actu <> "" Then
  8. ActiveChart.ChartArea.Select
  9. Set newseri = ActiveChart.SeriesCollection.NewSeries
  10. newseri.XValues = "('" & nom & "'!R" & 1 + i & "C3, '" & nom & "'!R" & 1 + i & "C14)"
  11. ActiveChart.SeriesCollection(6).Values = "('" & nom & "'!R" & 1 + i & "C4, '" & nom & "'!R" & 1 + i & "C15)"
  12. ActiveChart.SeriesCollection(6).Name = "='" & nom & "'!R" & 1 + i & "C1"
  13. ActiveChart.SeriesCollection(6).Border.ColorIndex = 6
  14. ActiveChart.SeriesCollection(6).MarkerStyle = none
  15. ActiveChart.Legend.LegendEntries(4).Delete
  16. Else
  17. End If
  18. Next i
  19. End Sub
m
0
l
a b L Programmation
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 :/ 
m
0
l
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
  1. Count
que tu m'as proposé pour les incrémenter puisqu'à chaque nouvel indice j'utilise la méthode
  1. 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
m
0
l
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
  1. "" & ""
  1.  
:
  1. Sub BATONNETS()
  2. '
  3. ' BATONNETS Macro
  4. ActiveChart.ChartArea.Select
  5. For i = 1 To 300
  6. actu = Cells(1 + i, 3).Value
  7. If actu <> "" Then
  8. nom = "SECT 06000"
  9. Set newseri = ActiveChart.SeriesCollection.NewSeries
  10. newseri.XValues = "('" & nom & "'!R" & 1 + i & "C3, '" & nom & "'!R" & 1 + i & "C14)"
  11. newseri.Values = "('" & nom & "'!R" & 1 + i & "C4, '" & nom & "'!R" & 1 + i & "C15)"
  12. newseri.Name = "='" & nom & "'!R" & 1 + i & "C1"
  13. newseri.Border.ColorIndex = 6
  14. newseri.MarkerStyle = none
  15. ActiveChart.Legend.LegendEntries(4).Delete
  16. Else
  17. End If
  18. Next i
  19. End Sub
m
0
l
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 "
  1. 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...
m
0
l
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 :
  1. ma_feuil = "SECT 06000"

après ça je ne peux pas attribuer un nom à une valeur de la cellule de "ma_feuil" comme ça ?
  1. actu = ma_feuil.Cells(1 + i, 3).Value
m
0
l
a b L Programmation
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 !
m
0
l
a b L Programmation
1 Février 2013 09:03:53

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

  1. Dim ma_feuille As Worksheet
  2. Dim mon_nom_de_feuille As String
  3.  
  4. mon_nom_de_feuille = "SECT 6000"
  5. Set ma_feuille = Worksheets(mon_nom_de_feuille)
  6.  
  7. 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).

  1. Dim ma_cellule As Range ' // Il n'y a pas de type Cell en VBA/Excel ! Range c'est plusieurs cellules
  2. Dim ma_valeur As Variant
  3.  
  4. Set ma_cellule = Worksheets.Cells(1 + i, 3)
  5. ma_valeur = ma_cellule.Value
m
0
l
a b L Programmation
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 ;)  )
m
0
l
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...
m
0
l
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
  1. Sub BATONNETS()
  2.  
  3. ' hyp. sélection graphe au début
  4. Dim ma_feuille As Worksheet
  5. Dim mon_nom_de_feuille As String
  6. Dim ma_cellule As Range
  7. Dim ma_valeur As Variant
  8. Dim mon_chart As ChartObject
  9.  
  10. Message = "Entrer le nom de l'onglet à traiter"
  11. Title = "Onglet à traiter"
  12. mon_nom_de_feuille = InputBox(Message, Title)
  13. Set ma_feuille = Worksheets(mon_nom_de_feuille)
  14.  
  15. For i = 1 To 300
  16. Set ma_cellule = ma_feuille.Cells(1 + i, 3)
  17. ma_valeur = ma_cellule.Value
  18. If ma_valeur <> "" Then
  19. MsgBox ma_feuille.ChartObjects(1)
  20. 'mon_chart = ma_feuille.ChartObjects(1).Chart.ChartArea.Select
  21. Set newseri = ActiveChart.SeriesCollection.NewSeries
  22. newseri.XValues = "('" & ma_feuille & "'!R" & 1 + i & "C3, '" & ma_feuille & "'!R" & 1 + i & "C14)"
  23. newseri.Values = "('" & ma_feuille & "'!R" & 1 + i & "C4, '" & ma_feuille & "'!R" & 1 + i & "C15)"
  24. newseri.Name = "='" & ma_feuille & "'!R" & 1 + i & "C1"
  25. newseri.Border.ColorIndex = 6
  26. newseri.MarkerStyle = none
  27. ActiveChart.Legend.LegendEntries(4).Delete
  28. ' il y a déjà 3 courbes dans ma légende au momen où je lance ma macro
  29. End If
  30. Next i
  31. End Sub
m
0
l
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 ...
m
0
l
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

  1. Sub BATONNETS()
  2.  
  3. ' hyp. sélection graphe au début
  4. Dim ma_feuille As Worksheet
  5. Dim mon_nom_de_feuille As String
  6. Dim ma_cellule, ma_cellule1, ma_cellule2, ma_cellule3, ma_cellulex, ma_celluley As Range
  7. Dim ma_valeur As Variant
  8. Dim newseri As Series
  9.  
  10. Message = "Entrer le nom de l'onglet à traiter"
  11. Title = "Onglet à traiter"
  12. mon_nom_de_feuille = InputBox(Message, Title)
  13. Set ma_feuille = Worksheets(mon_nom_de_feuille)
  14.  
  15. For i = 1 To 300
  16. Set ma_cellule = ma_feuille.Cells(1 + i, 3)
  17. ma_valeur = ma_cellule.Value
  18. If ma_valeur <> "" Then
  19. Set ma_cellule1 = ma_feuille.Cells(1 + i, 14)
  20. Set ma_cellule2 = ma_feuille.Cells(1 + i, 4)
  21. Set ma_cellule3 = ma_feuille.Cells(1 + i, 15)
  22. Set ma_cellulex = Union(ma_cellule, ma_cellule1)
  23. Set ma_celluley = Union(ma_cellule2, ma_cellule3)
  24. Set newseri = ActiveChart.SeriesCollection.NewSeries
  25. newseri.XValues = ma_cellulex
  26. newseri.Values = ma_celluley
  27. newseri.Name = "='" & mon_nom_de_feuille & "'!R" & 1 + i & "C1"
  28. newseri.Border.ColorIndex = 6
  29. newseri.MarkerStyle = none
  30. ActiveChart.Legend.LegendEntries(4).Delete
  31. End If
  32. Next i
  33. End Sub
m
0
l
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

  1. Sub BATONNETS()
  2.  
  3. Dim ma_feuille As Worksheet
  4. Dim mon_nom_de_feuille As String
  5. Dim ma_cellule As Range
  6. Dim ma_valeur As Variant
  7. Dim newseri As Series
  8.  
  9. Message = "Entrer le nom de l'onglet à traiter"
  10. Title = "Onglet à traiter"
  11. mon_nom_de_feuille = InputBox(Message, Title)
  12. Set ma_feuille = Worksheets(mon_nom_de_feuille)
  13.  
  14. For i = 1 To 300
  15. Set ma_cellule = ma_feuille.Cells(1 + i, 3)
  16. ma_valeur = ma_cellule.Value
  17. If ma_valeur <> "" Then
  18. Set newseri = ActiveChart.SeriesCollection.NewSeries
  19. newseri.XValues = Range(ma_feuille.Cells(1 + i, 27), ma_feuille.Cells(1 + i, 28))
  20. newseri.Values = Range(ma_feuille.Cells(1 + i, 29), ma_feuille.Cells(1 + i, 30))
  21. newseri.Name = "='" & mon_nom_de_feuille & "'!R" & 1 + i & "C1"
  22. newseri.Border.ColorIndex = 6
  23. newseri.MarkerStyle = none
  24. ActiveChart.Legend.LegendEntries(4).Delete
  25. ' il y a déjà 3 courbes dans ma légende au moment où je lance ma macro
  26. End If
  27. Next i
  28. End Sub
m
0
l
a b L Programmation
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 :

  1. Option Explicit
  2.  
  3. Sub BATONNETS_revu()
  4. Dim ws As Worksheet
  5. Dim ma_feuille As Worksheet
  6. Dim mon_nom_de_feuille As String
  7. Dim ma_ligne As Range
  8. Dim ma_serie As Series
  9. Dim mon_graphe As ChartObject
  10.  
  11. Set ma_feuille = Nothing
  12. ' mon_nom_de_feuille = InputBox("Entrer le nom de l'onglet à traiter", "Onglet à traiter")
  13. mon_nom_de_feuille = "Feuil1"
  14. For Each ws In Worksheets
  15. If ws.Name = mon_nom_de_feuille Then
  16. Set ma_feuille = Worksheets(mon_nom_de_feuille)
  17. Exit For
  18. End If
  19. Next
  20.  
  21. If ma_feuille Is Nothing Then
  22. MsgBox "Feuille inconnue !" & vbCrLf & "Procédure interrompue.", vbCritical
  23. Exit Sub
  24. End If
  25. If ma_feuille.ChartObjects.Count <> 1 Then
  26. Dim message_erreur As String
  27. If ma_feuille.ChartObjects.Count = 0 Then message_erreur = "Il n'y a pas de" Else message_erreur = "Il y a plus d'un"
  28. MsgBox message_erreur & " graphe sur cette feuille !" & vbCrLf & "Procédure interrompue.", vbCritical
  29. Exit Sub
  30. End If
  31. Set mon_graphe = ma_feuille.ChartObjects(1)
  32.  
  33. For Each ma_ligne In Intersect(ma_feuille.Range(ma_feuille.Rows(2), ma_feuille.Rows(ma_feuille.Rows.Count)), _
  34. ma_feuille.Range("C1").CurrentRegion.EntireRow).Rows
  35. Set ma_serie = mon_graphe.Chart.SeriesCollection.NewSeries
  36. ma_serie.XValues = ma_feuille.Range(ma_ligne.Cells(27), ma_ligne.Cells(28))
  37. ma_serie.Values = ma_feuille.Range(ma_ligne.Cells(29), ma_ligne.Cells(30))
  38. ma_serie.Name = "=" & ma_feuille.Name & "!" & ma_ligne.Cells(1).Address
  39. ma_serie.Border.ColorIndex = 6
  40. ma_serie.MarkerStyle = xlMarkerStyleNone
  41. Do While ma_serie.Legend.LegendEntries.Count > 3
  42. ma_serie.Legend.LegendEntries(ma_serie.Legend.LegendEntries.Count).Delete
  43. Loop
  44. Next
  45. End Sub


A étudier, mot à mot ;) 
m
0
l