Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim xlSheet1 As Excel.Worksheet
Dim i As Integer, tmHour As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
On Error Resume Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set xlApp = Excel.Application
Set xlBook = xlApp.Workbooks.Add
'xlBook.Activate
Set xlSheet = xlBook.Worksheets(1) '''''''''''''''''''''''''''''''''引用第1张工作表
xlApp.ActiveSheet.Rows.VerticalAlignment = xlVAlignCenter '''''垂直方向居中
xlApp.ActiveSheet.Rows.HorizontalAlignment = xlVAlignCenter '''水平方向居中
xlSheet.Name = "实测值"
Set xlSheet1 = xlBook.Worksheets(2)
xlSheet1.Name = "Chart"
With xlSheet
For i = 2 To 11
.Range(Cells(1, 1), Cells(1, i)).Merge ''''''''''''''''''''合并A-K单元格
Next
' .Cells(1, 1).ForeColor = RGB(100, 150, 255)
.Cells(1, 1).Font.Size = 25
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''设置行高'设置列宽
For i = 1 To 22
.Rows(i).RowHeight = 25
Next
For i = 1 To 11
.Columns(i).ColumnWidth = 15
Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''合并单元格
For i = 3 To 22
If i < 8 Then
.Range(Cells(3, 1), Cells(i, 1)).Merge '''''''''''''合并A3-A7单元格
.Range(Cells(3, 8), Cells(i, 8)).Merge '''''''''''''合并H3-H7单元格
ElseIf i < 13 Then
.Range(Cells(8, 1), Cells(i, 1)).Merge
.Range(Cells(8, 8), Cells(i, 8)).Merge
ElseIf i < 18 Then
.Range(Cells(13, 1), Cells(i, 1)).Merge
.Range(Cells(13, 8), Cells(i, 8)).Merge
ElseIf i < 23 Then
.Range(Cells(18, 1), Cells(i, 1)).Merge
.Range(Cells(18, 8), Cells(i, 8)).Merge
End If
Next
''''''''''''''''''''''''''''''''''''''''''''
.Range("A1", "K22").Borders.LineStyle = xlContinuous '''''''''''单元格边框
.Range("A1", "K22").Borders.Color = vbBlue ''''''''''''''''''''''边框颜色
.Range("A1", "K22").Interior.Color = RGB(100, 180, 0) '''''''''''区域 背景色
'''''''''''''''''''''''''''''''''''电压值
.Range("A3").Value = "90"
.Range("A8").Value = "115"
.Range("A13").Value = "230"
.Range("A18").Value = "264"
End With
tmHour = "-" & Hour(Time)
tmHour = tmHour & "-" & Minute(Time)
tmHour = tmHour & "-" & Second(Time)
xlApp.ActiveWorkbook.SaveAs App.Path & "\" & Format(Date, dddd, mmmm, yyyy) & tmHour + ".xls"
xlApp.Workbooks.Close
xlApp.Quit
Set xlApp = Nothing '释放引用