ExcelVBA自动插入多个曲线图.docxVIP

vba 添加曲线有几十个部门，我想每个销售部得到一个曲线图，就像第一个图那样，我写的代码如下：Sub 逐个插入图表()在指定位置作图清除已有图表nohang = Range(c65536).End(xlUp).RowFor Each r In Sheets(销售数据).ChartObjectsr.DeleteNextDim ab As RangeDim e As RangeDim bbb As ChartObjectDim xx As Integer, yy As Integer, zz As IntegerFor m = 1 To 3 Step 1xx = (m - 1) * 20 + 4yy = (m - 1) * 20 + 22zz = m * 3Set e = Range(Range(Cells(441, 2), Cells(nohang, 2)), Range(Cells(441, zz), Cells(nohang, zz + 2)))Set ab = Range(b xx, i yy) 生成图表的位置Set bbb = ActiveSheet.ChartObjects.Add(ab.Left, ab.Top, ab.Width, ab.Height)With bbb.Chart .ChartType = xlLine?折线图 .SetSourceData Source:=e 数据源以下是图表属性设置? With .Axes(xlValue)?.MinimumScaleIsAuto = True?.MaximumScaleIsAuto = True?.MinorUnitIsAuto = True?.MajorUnitIsAuto = True?.Crosses = xlAutomatic?.ReversePlotOrder = False?.ScaleType = xlLinear?.DisplayUnit = xlTenThousands?.HasDisplayUnitLabel = True End With With .Axes(xlCategory) .TickLabels.AutoScaleFont = True?With .TickLabels.Font?.Name = 宋体?.FontStyle = 常规?.Size = 9?.Strikethrough = False?.Superscript = False?.Subscript = False?.OutlineFont = False?.Shadow = False?.Underline = xlUnderlineStyleNone?.ColorIndex = xlAutomatic?.Background = xlAutomatic?End With End With With .Legend .AutoScaleFont = True .Position = xlTop .Height = 24?With .Font?.Name = 宋体?.FontStyle = 常规?.Size = 9?.Strikethrough = False?.Superscript = False?.Subscript = False?.OutlineFont = False?.Shadow = False?.Underline = xlUnderlineStyleNone?.ColorIndex = xlAutomatic?.Background = xlAutomatic?End With End With With .SeriesCollection(1)?With .Border?.ColorIndex = 6?.Weight = xlMedium?.LineStyle = xlContinuous?End With?.MarkerBackgroundColorIndex = xlNone?.MarkerForegroundColorIndex = xlNone?.MarkerStyle = xlNone?.Smooth = False?.MarkerSize = 3?.Shadow = False End With With .SeriesCollection(2)?With .Border?.ColorIndex = 5?.Weight = xlMedium?.LineStyle = xlContinuous?End With?.MarkerBackgroundColorIndex = xlNone?.MarkerForegroundColorIndex = xlNone?.MarkerStyle = xlNone?.Smooth = False?