一个完整的VBA画图程序

Sub 五月九月价差图()

Dim ch As ChartObject
Dim myrow As Long
Dim sh, sh59 As Worksheet
Dim rngD, rngc1, rngc2, rngp1, rngp2, rngs As Range

Set sh = Worksheets("workingarea")
Set sh59 = Worksheets("九月减五月")
sh59.Activate
myrow = sh.[a65536].End(xlUp).Row
'-----------------------------------------------------------------------------------------------------------------------
'
'定义时1为近月，2为远月，这样也为了以后方便修改
Set rngD = sh.Range("a3:a" & myrow)     '日期列
Set rngc1 = sh.Range("e3:e" & myrow)    '五月收盘
Set rngc2 = sh.Range("h3:h" & myrow) '九月收盘
Set rngp1 = sh.Range("g3:g" & myrow) '五月持仓
Set rngp2 = sh.Range("j3:j" & myrow)  '九月持仓
Set rngs = sh.Range("o3:o" & myrow) '五九价差

'开始绘图
On Error GoTo err:
sh59.ChartObjects("五九价差与持仓").Delete   '确保这是唯一的图
err:
Set ch = sh59.ChartObjects.Add(0, 0, 600, 300)  '定义位置极其大小
ch.Name = "五九价差与持仓"    '图表定名
'为图表填加数据
With ch.Chart
            .ChartType = xlLine
            .SeriesCollection.NewSeries    '这个必须得有
            .SeriesCollection(1).Values = rngs  '价差
            .SeriesCollection(1).XValues = rngD  '横轴为时间
            .SeriesCollection(1).Name = "五九价差"
            .SeriesCollection.NewSeries
            .SeriesCollection(2).Values = rngp1 '五月持仓
            .SeriesCollection(2).XValues = rngD
            .SeriesCollection(2).Name = "五月持仓"
            .SeriesCollection.NewSeries
            .SeriesCollection(3).Values = rngp2 '九月持仓
            .SeriesCollection(3).XValues = rngD
            .SeriesCollection(3).Name = "九月持仓"
End With
 '设置折线格式
  
   ch.Chart.SeriesCollection(1).AxisGroup = 2     '很奇怪，不能将这几句放到上一段去，可能是因为newseries的关系吧
   ch.Chart.SeriesCollection(1).MarkerStyle = xlNone
   ch.Chart.SeriesCollection(2).AxisGroup = 1
   ch.Chart.SeriesCollection(2).MarkerStyle = xlNone
   ch.Chart.SeriesCollection(3).AxisGroup = 1
   ch.Chart.SeriesCollection(3).MarkerStyle = xlNone
  
  
'定义坐标主轴、副轴、横轴的格式
  
With ch.Chart.Axes(xlValue, xlPrimary)    '定义主y轴
             .MajorUnit = Int((WorksheetFunction.Max(rngp1.Value, rngp2.Value) * 1.5 - WorksheetFunction.Min(rngp1.Value, rngp2.Value)) / 100) * 100 / 10 '一开始我直接把最大值乘以1.2，最小值乘以0.8，可是遇到负数就麻烦了
             .MaximumScale = Int((WorksheetFunction.Max(rngp1.Value, rngp2.Value) * 1.5 + .MajorUnit) / 100) * 100
             .MinimumScale = Int((WorksheetFunction.Min(rngp1.Value, rngp2.Value) * -.MajorUnit) / 100) * 100
             .CrossesAt = .MinimumScale  '与y轴交叉于最小值
             .TickLabels.Font.Size = 8   'y轴字体大小
            
End With
              
With ch.Chart.Axes(xlValue, xlSecondary)  '定义副y轴
             .MajorUnit = (WorksheetFunction.Max(rngs.Value) - WorksheetFunction.Min(rngs.Value)) / 10
             .MaximumScale = Int((WorksheetFunction.Max(rngs.Value) + .MajorUnit) / 100) * 100
             .MinimumScale = Int((WorksheetFunction.Min(rngs.Value) - .MajorUnit) / 100) * 100
             .CrossesAt = .MinimumScale
             .TickLabels.Font.Size = 8
End With

With ch.Chart.Axes(xlCategory).TickLabels     '定义x轴即分类轴的字体和格式
        .Font.Size = 8
        .NumberFormatLocal = "yy-m-d"
End With

'设置标题、图例格式和绘图区大小
With ch.Chart
             .HasTitle = True
             .ChartTitle.Text = ch.Name
             .ChartTitle.Font.Size = 12
             .ChartTitle.Font.Bold = True
             .ChartTitle.Left = ch.Width / 2.2
             .Legend.Font.Size = 8
             .PlotArea.Width = 580
             .PlotArea.Left = 10
             .PlotArea.Top = 10
             .PlotArea.Height = 290
             .ChartTitle.Top = .PlotArea.InsideTop
             .Legend.Left = .PlotArea.InsideLeft
             .Legend.Top = .PlotArea.InsideTop
End With

Set ch = Nothing

 

end sub