搜索
人大经济论坛 附件下载

附件下载

所在主题:
文件名:  gerengongzuo.xlsx
资料下载链接地址: https://bbs.pinggu.org/a-1664461.html
附件大小:
59.84 KB   举报本内容
求教大神,本人初学VBA,书上的这段代码运行不出来,请教下面红色那里是怎么错的
Sub CreatedStackedChart()
Dim Cht As Chart
Dim Ser As Series
finalrow = Cells(Rows.Count, 1).End(xlUp).Row
finalcol = Cells(1, Columns.Count).End(xlToLeft).Column
OrigSeriesCount = finalcol - 1
finalseriescount = OrigSeriesCount * 2
ChtHeight = 1000
LabSize = 200
nextcol = finalcol + 2
Cells(1, 1).Resize(finalrow, finalcol).Copy Destination:=Cells(1, nextcol)
finalcol = Cells(1, Columns.Count).End(xlToLeft).Column
MyFormula = "= & ChtHeight & RC[-1]"
For i = finalcol + 1 To nextcol + 2 Step -1
Cells(1, i).EntireColumn.Insert
Cells(1, i).Value = "dummy"
Cells(2, i).Resize(finalrow - 1, l).FormulaR1C1 = MyFormula
Next i
finalcol = Cells(1, Columns.Count).End(xlToLeft).Column
ActiveSheet.Shapes.AddChart(xlAreaStacked).Select
Set Cht = ActiveChart
Cht.SetSourceData Source:=Range(Cells(1, nextcol), Cells(finalrow, finalcol))
Cht.PlotBy = xlColumns
For i = finalseriescount - 1 To 1 Step -2
Cht.Legend.LegendEntries(i).Delete
Next i
TopScale = OrigSeriesCount * ChtHeight
With Cht.Axes(xlValue)
.MaximumScale = TopScale
.MinorUnit = LabSize
.MajorUnit = ChtHeight
End With
Cht.SetElement (msoElementPrimaryValueGridLinesMinorMajor)
For i = finalseries To 2 Step -2
Cht.SeriesCollection(i).Interior.ColorIndex = xlNone
Next i
Cht.Axes(xlValue).TickLabelPositon = xlNone
AxisRow = finalrow + 2
Cells(AxisRow, 1).Resize(1, 3).Value = Array("Label", "X", "Y")
TickMarkCount = OrigSeriesCount * (ChtHeight / LabSize) + 1
Cells(AxisRow + 1, 2).Resize(TickMarkCount, 1).Value = 0
Cells(AxisRow + 1, 3).Resize(TickMarkCount, 1).FormulaR1C1 = "=R[-1]C+" & LabSize
Cells(AxisRow + 1, 3).Value = 0
Cells(AxisRow + 1, 1).Value = 0
Cells(AxisRow + 2, 1).Resize(TickMarkCount - 1, 1).FormulaR1C1 = "=IF(r[-1]c+" & LabSize & " >= " & ChtHeight & ",0,r[-1]c+" & LabSize & ")"
newfinal = Cells(Rows.Count, 1).End(xlUp).Row
Cells(newfinal, 1).Value = ChtHeight
Set Ser = Cht.SeriesCollection.NewSeries
With Ser
.Name = "Y"
.Values = Range(Cells(AxisRow + 1, 3), Cells(newfinal, 3))
.XValues = Range(Cells(AxisRow + 1, 2), Cells(newfinal, 2))
.ChartType = x1XYScatter
.MarkerStyle = xlMarkerStyleNone
End With
For i = 1 To TickMarkCount
Ser.Points(i).HasDataLabel = True
Ser.Points(i).DataLabel.Text = Cells(AxisRow + i, 1).Value
Next i
Cht.Legend.LegendEntries(Cht.Legend.LegendEntries.Count).Delete
End Sub




    熟悉论坛请点击新手指南
下载说明
1、论坛支持迅雷和网际快车等p2p多线程软件下载,请在上面选择下载通道单击右健下载即可。
2、论坛会定期自动批量更新下载地址,所以请不要浪费时间盗链论坛资源,盗链地址会很快失效。
3、本站为非盈利性质的学术交流网站,鼓励和保护原创作品,拒绝未经版权人许可的上传行为。本站如接到版权人发出的合格侵权通知,将积极的采取必要措施;同时,本站也将在技术手段和能力范围内,履行版权保护的注意义务。
(如有侵权,欢迎举报)
二维码

扫码加我 拉你入群

请注明:姓名-公司-职位

以便审核进群资格,未注明则拒绝

GMT+8, 2025-12-31 04:16