Nuage de points, étiquettes et plusieurs séries

[Imperium]

Bonjour à tous et par avance, un grand merci pour votre aide.

Dans le cadre de mon activité, j'ai besoin de réaliser les fameux nuages de points, avec une particularité, afficher à côté de chaque point le nom auquel il correspond (je ne parle pas du nom de la série, mais d'un nom situé sur la même ligne que la donnée, à gauche).

Par exemple, si j'ai trois colonnes "nom" "age" "salaire", mon nuage de point va ventiler les ages en abscisse et les salaires en ordonnées, et à coté de chaque point va s'afficher le nom de la personne à qui correspond la coordonnée. Bref, pour faire ça j'utilisais jusqu'à maintenant une macro donnée par microsoft lui même :

Comment faire pour utiliser une macro pour ajouter des étiquettes aux points de données dans un graphique à nuages de points (XY) ou un graphique à bulles dans Excel

A savoir :

Sub AttachLabelsToPoints()

   'Dimension variables.
   Dim Counter As Integer, ChartName As String, xVals As String

   ' Disable screen updating while the subroutine is run.
   Application.ScreenUpdating = False

   'Store the formula for the first series in "xVals".
   xVals = ActiveChart.SeriesCollection(1).Formula

   'Extract the range for the data from xVals.
   xVals = Mid(xVals, InStr(InStr(xVals, ","), xVals, _
      Mid(Left(xVals, InStr(xVals, "!") - 1), 9)))
   xVals = Left(xVals, InStr(InStr(xVals, "!"), xVals, ",") - 1)
   Do While Left(xVals, 1) = ","
      xVals = Mid(xVals, 2)
   Loop

   'Attach a label to each data point in the chart.
   For Counter = 1 To Range(xVals).Cells.Count
     ActiveChart.SeriesCollection(1).Points(Counter).HasDataLabel = _
         True
      ActiveChart.SeriesCollection(1).Points(Counter).DataLabel.Text = _
         Range(xVals).Cells(Counter, 1).Offset(0, -1).Value
   Next Counter

End Sub

Le problème, et ce pourquoi j'ai aujourd’hui besoin de votre aide, c'est qu'à présent j'ai plusieurs séries dans mon nuage de points (une dizaine), et que ma macro ne s'occupe que de la première. J'ai bien essayé de bidouiller en créant une deuxième macro et en remplaçant ActiveChart.SeriesCollection(1) par ActiveChart.SeriesCollection(2) mais cela marche une fois sur deux, et comme il y a des graphs qui vont avoir jusqu'à 20 séries et à mettre à jour régulièrement, je me demandais si on pouvait tout condenser en une

Un grand merci d'avance pour votre aide !

 

[MJ13]

Re : Nuage de points, étiquettes et plusieurs séries

Bonjour Imperium

Regarde dans cette discussion, on en a parlé.

https://www.excel-downloads.com/threads/urgent-graphique-nuage.229355/

 

[MJ13]

Re : Nuage de points, étiquettes et plusieurs séries

Re

Sinon, voici, un exemple avec 2 séries.

 

[Imperium]

Re : Nuage de points, étiquettes et plusieurs séries

J'ai regardé, merci pour cette réponse mais je ne suis pas vraiment sûr que cela réponde à ma demande, puisque dans les fait j'aurai jusqu'à une vingtaine de séries ;(
Le top serait de pouvoir adapter la macro ci-dessus qui fonctionne très facilement, et lui demande de boucler sur toutes les séries plutôt que sur une seule Si bien sur ce n'est pas trop compliqué !

 

[MJ13]

Re : Nuage de points, étiquettes et plusieurs séries

Re

Ben, oui, maintenant, y'a plus qu'a .

Rien ne t'empêche de nommer tes zones de libellés et de faire un petite boucle.

 

[MJ13]

Re : Nuage de points, étiquettes et plusieurs séries

Re

Avec une petite boucle en nommant les séries avec les libéllés de Serie 1 à N, cela devrait le faire:

Sub Etiquettes_Graphiques_Sel_Données()
'MJ
Dim Nom(1000) As Variant
ActiveSheet.ChartObjects(1).Activate
For J = 1 To 2
Nom(J) = Range("Serie" & J).Name 'Application.InputBox("Sélectionnez la plage des noms", "SÉLECTION", Type:=8)

With ActiveChart.SeriesCollection(J)
        .ApplyDataLabels Type:=xlDataLabelsShowLabel
        For i = 1 To ActiveChart.SeriesCollection(J).Points.Count
          With .Points(i)
                      .DataLabel.Text = ActiveSheet.Range("Serie" & J).Item(i)
             .DataLabel.Font.Size = 14
          End With
        Next i
   End With
   Next
ActiveChart.Deselect
End Sub