'绘制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)