| 所在主题: | |
| 文件名: gerengongzuo.xlsx | |
| 资料下载链接地址: https://bbs.pinggu.org/a-1664461.html | |
| 附件大小: | |
|
求教大神,本人初学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、本站为非盈利性质的学术交流网站,鼓励和保护原创作品,拒绝未经版权人许可的上传行为。本站如接到版权人发出的合格侵权通知,将积极的采取必要措施;同时,本站也将在技术手段和能力范围内,履行版权保护的注意义务。 (如有侵权,欢迎举报) |
|
京ICP备16021002号-2 京B2-20170662号
京公网安备 11010802022788号
论坛法律顾问:王进律师
知识产权保护声明
免责及隐私声明