VB实现多Y轴Excel图表绘制：源代码示例

'绘制EXCEL：4个坐标轴图表
Private Sub Command1_Click()
On Error GoTo ErrHandler 'Resume Next
Dim filePath As String, tmp1, tmp2, Data(1 To 10, 0 To 65000) As Variant
Dim i As Integer, j As Integer
Dim x1, x2, y1, y2, tmp As Variant, y, ShapeName As String
Dim Res

With main
'//*************
    .CommonDialog1.InitDir = "E:\y4"
    .CommonDialog1.CancelError = True ' 设置标志
    .CommonDialog1.Flags = cdlOFNHideReadOnly
    .CommonDialog1.Filter = "Excel(*.xls)|*.xls|所有文件（*.*）|*.*" ' 设置过滤器
    .CommonDialog1.FilterIndex = 0 ' 指定缺省的过滤器
    .CommonDialog1.fileName = "3个Y坐标轴图表.xls" 
    .CommonDialog1.ShowOpen ' 显示“打开”对话框
        filePath = .CommonDialog1.fileName ' 显示选定文件的名字
End With
If Err.Number = 32755 Or filePath = "" Then GoTo ErrHandler ' 用户按了“取消”按钮

'*************//打开xls file
On Error GoTo ErrHandler
   Set xlAPP = CreateObject("Excel.Application") 'Excel没有运行,创建EXCEL对象
       xlAPP.Visible = True '保存完以后再显示
   Set xlBook = xlAPP.Workbooks.Open(filePath)

Res = MsgBox("第F列将被覆盖，请移去有用数据！确认当前F列没有关键数据？", vbYesNo, "请注意：")
If Res <> 6 Then Exit Sub

Screen.MousePointer = vbHourglass '11 沙漏
xlAPP.Visible = True

With xlBook.ActiveSheet
i = 1
Do While .Cells(i, 1) <> ""
   For j = 1 To 5
      Data(j, i - 1) = Trim(.Cells(i, j).Value) '原始数据
   Next j
   i = i + 1
Loop

k = 11 'MAX MIN产生在第10列
tmp = .Cells(1, 11)
.Cells(1, 11).FormulaR1C1 = "=MAX(R[1]C[" & 1 - k & "]:R[" & i - 2 & "]C[" & 1 - k & "])"
日期max = Format(.Cells(1, 11), "yyyy-m-d"): .Cells(1, 11) = tmp

tmp = .Cells(2, 11)
.Cells(2, 11).FormulaR1C1 = "=Min(RC[" & 1 - k & "]:R[" & i - 3 & "]C[" & 1 - k & "])"
.Cells(2, 11).NumberFormatLocal = "yyyy-m-d"
日期min = .Cells(2, 11): .Cells(2, 11) = tmp

tmp = .Cells(3, 11)
.Cells(3, 11).FormulaR1C1 = "=Max(R[-1]C[" & 2 - k & "]:R[" & i - 4 & "]C[" & 2 - k & "])"
油压max = .Cells(3, 11): .Cells(3, 11) = tmp
tmp = .Cells(4, 11)
.Cells(4, 11).FormulaR1C1 = "=Min(R[-2]C[" & 2 - k & "]:R[" & i - 5 & "]C[" & 2 - k & "])"
油压min = .Cells(4, 11): .Cells(4, 11) = tmp

 tmp = .Cells(5, 11)