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

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? ?? ?? ?? ?.L