Option
Explicit
Sub
TryThis()
Dim
oWsh
As
Worksheet
Dim
oShp
As
Shape
Dim
oChart
As
Chart
Dim
oColl
As
Series
Dim
oPoint
As
Point
Dim
oDtaLabel
As
DataLabel
Dim
rngUsed
As
Range, rngSource
As
Range, rngData
As
Range
Dim
rngX
As
Range, rngY
As
Range, rngBubble
As
Range
Dim
x
As
Long
Set
oWsh = ThisWorkbook.ActiveSheet
With
oWsh
For
Each
oShp
In
.Shapes
oShp.Delete
Next
oShp
Set
rngUsed = .Cells(1, 1).CurrentRegion
Set
rngData = rngUsed.Offset(1, 0).Resize(rngUsed.Rows.Count - 1, _
rngUsed.Columns.Count)
Set
rngX = rngData.Columns(1)
Set
rngY = rngData.Columns(2)
Set
rngBubble = rngData.Columns(3)
Set
oShp = .Shapes.AddChart(xlBubble)
Set
oChart = oShp.Chart
With
oChart
.SetSourceData Source:=Range(rngX, rngY)
.Legend.Delete
Set
oColl = .SeriesCollection(1)
For
Each
oPoint
In
oColl.Points
oPoint.ApplyDataLabels
x = x + 1
oPoint.DataLabel.Text = rngBubble.Cells(x).Value
On
Error
Resume
Next
oPoint.Format.Fill.ForeColor.SchemeColor = x + 1
On
Error
GoTo
0
Next
oPoint
End
With
With
oShp
.Top = 200
.Left = 200
End
With
End
With
End
Sub