Sub MesBulles()
Dim rg As Range, MyShp As Shape, MyChart As Chart, Ns As Series
Set rg = Sh_Graph.[Données]
On Error Resume Next: Sh_Graph.Shapes("Graphe à Bulles").Delete: On Error GoTo 0
Set MyShp = Sh_Graph.Shapes.AddChart2(, xlBubble, Sh_Graph.[Pos_Graph].Left, Sh_Graph.[Pos_Graph].Top, 800, 400)
MyShp.Name = "Graphe à Bulles"
Set MyChart = MyShp.DrawingObject.Chart
MyChart.HasTitle = True
MyChart.ChartTitle.Formula = "='" & Sh_Graph.Name & "'!Titre"
For i = 2 To rg.Rows.Count
Set Ns = MyChart.SeriesCollection.NewSeries
With Ns
.Name = rg.Rows(i).Cells(1)
.XValues = rg.Rows(i).Cells(4)
.Values = rg.Rows(i).Cells(3)
.BubbleSizes = rg.Rows(i).Cells(2)
.HasDataLabels = True
.DataLabels(1).ShowValue = False
.DataLabels(1).ShowSeriesName = True
.Format.Fill.ForeColor.RGB = rg.Rows(i).Cells(5).Interior.Color
End With
Next i
With MyChart.Axes(xlValue)
.MinimumScale = 0
.HasTitle = True
.AxisTitle.Formula = "='" & Sh_Graph.Name & "'!" & rg.Rows(1).Cells(3).Address
End With
With MyChart.Axes(xlCategory)
.MinimumScale = 0
.HasTitle = True
.AxisTitle.Formula = "='" & Sh_Graph.Name & "'!" & rg.Rows(1).Cells(4).Address
End With
End Sub