Graphique Nuage de points

hartmutm

XLDnaute Nouveau
Hello,
Merci tout d'abord pour l'aide apportée par ce forum.
Hier, j'ai trouvé un macro qui permet de définir librement les étiquettes des points. Mais j'ai besoin de plusieurs séries de données sur le même graphique. Je suis assez nul en VBA. Pourrait quelqu'un modifier le macro ci après pour qu'on puisse créer plusieurs séries de données.
Merci d'avance pour votre aide.
Hartmut

Voici le macro à modifier / compléter:


Sub graphiqueeasy()
'
' Macro3 Macro
' Macro enregistrée le 07/08/2003 par CPi
'

Set valeursx = Application.InputBox(prompt:="Sélectionnez les valeurs des X", Type:=8)
Set valeursy = Application.InputBox(prompt:="Selectionnez les valeurs des Y", Type:=8)
Set nomz = Application.InputBox(prompt:="Selectionnez les noms de vos points", Type:=8)

Application.ScreenUpdating = False

R = nomz.Rows.Count - 1
adr = nomz.Cells(1).Address(ReferenceStyle:=xlR1C1)
' feuilxyz = nomz.Cells(1).Sheets.Name
feuilxyz = ActiveSheet.Name

compt1 = 3
For k = compt1 To 255
If Mid(adr, k, 1) <> "C" Then
compt1 = compt1 + 1
Else
Exit For
End If
Next k

numeroligne = Mid(adr, 2, compt1 - 2)

compt2 = compt1 + 1
For m = compt2 To 255
If Mid(adr, m, 1) <> "" Then
compt2 = compt2 + 1
Else
Exit For
End If
Next m

numerocolone = Mid(adr, compt1 + 1, compt2 - compt1 + 1)

Charts.Add
ActiveChart.ChartType = xlXYScatter

ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(1).XValues = valeursx
ActiveChart.SeriesCollection(1).Values = valeursy

With ActiveChart
.Legend.Delete
.HasTitle = False
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
End With

ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).ApplyDataLabels AutoText:=True, LegendKey:= _
False, ShowSeriesName:=False, ShowCategoryName:=True, ShowValue:=False, _
ShowPercentage:=False, ShowBubbleSize:=False
ActiveChart.SeriesCollection(1).DataLabels.Select


For i = 1 To R + 1
ActiveChart.SeriesCollection(1).Points(i).DataLabel.Select
Selection.Text = "='" & feuilxyz & "'!R" & numeroligne & "C" & numerocolone
numeroligne = numeroligne + 1
Next i


End Sub
 

Discussions similaires

Réponses
1
Affichages
168
Réponses
0
Affichages
153

Statistiques des forums

Discussions
312 218
Messages
2 086 363
Membres
103 197
dernier inscrit
sandrine.lacaussade@orang