vbs:
Sub dttp()
On Error Resume Next
Dim rowend&, arr, i&, myShap As Shape, str As String, lastcol As Integer
rowend = Range("a" & Rows.Count).End(xlUp).Row
Shapes("违约分布").Delete
Set myShap = Shapes.AddChart
myShap.Name = "违约分布"
lastcol = ActiveSheet.UsedRange.Columns.Count
Dim MyNumber
MyNumber = Asc("A")
MyNumber = MyNumber + lastcol - 1
Dim MyChar
MyChar = Chr(MyNumber)
str = "B2 :" & MyChar
With myShap.Chart
.ChartType = xlLine
.HasTitle = True
.ChartArea.Height = ActiveSheet.UsedRange.Rows.Count * 2
.ChartArea.Width = lastcol + 600
.ChartTitle.Characters.Text = "违约分布"
.SetSourceData Source:=Range(str & rowend), PlotBy:=xlRows
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "概" & Chr(10) & "率"
.Axes(xlValue).AxisTitle.Orientation = xlHorizontal
' 更改图表2的水平类别轴的轴标签区域.
.SeriesCollection(1).XValues = "=Sheet1!$A$1:$H$1"
For i = 1 To ActiveSheet.UsedRange.Rows.Count
With myShap.Chart
.SeriesCollection(i).Name = ActiveSheet.Range("A" & i + 1)
End With
Next i
End With
End Sub