1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Public Sub WriteResToExcel() '写处理后的数据到新的Excel的过程
Dim xlApp As Excel.Application '定义一个Excel应用
Dim xlBook As Excel.Workbook '定义一个Excel Book
Dim xlSheet As Excel.Worksheet '定义一个Excel Sheet
'下面是取出打开的文件名后面添加一个时间戳作为新的文件名,该文件存放路径是程序的同目录下
DstFile = App.Path & "\" & Mid(FileNameE, 1, Len(FileNameE) - 5) & "_" & Format(Now, "yyyyMMddhhmmss") & ".xlsx"
'将打开的文件拷贝一份到程序同目录下的文件夹中,并重新命名为上面的文件名字
FileCopy Fpath, DstFile
Set xlApp = New Excel.Application
xlApp.Visible = False '不显示打开的Excel
Set xlBook = xlApp.Workbooks.Open(DstFile) '打开EXCEL工作簿
Set xlSheet = xlBook.Worksheets(1) '打开EXCEL工作表
Dim i As Integer
xlSheet.Cells(1, Rcount) = Ds(1, Rcount) '把数组ds(1,rcount)这个数据写入Excel中,写入的内容其实就是标题“计算结果”
For i = 2 To Hcount - 1 '再把数组ds(i,Rcount)的数据依次写入Excel表格中
xlSheet.Cells(i, Rcount) = GetTimeSl(Ds(i, Rcount))
Next i
xlBook.Close (True) '关闭并保存
'xlApp.DisplayAlerts = False '关闭EXCEL不提示保存
xlApp.Quit '关闭EXCEL
Set xlBook = Nothing '释放设置的资源
Set xlSheet = Nothing
Set xlApp = Nothing
End Sub