Dim m,i,j,n,filename
Dim objExcelApp,objExcelBook,objExcelSheet

Dim olist
Set olist=ScreenItems("MSHFGrid")
 'If olist.rows>1 Then
 
 '打开Excel模板
Set objExcelApp = CreateObject("Excel.Application")
objExcelApp.Visible = FalSE
' objExcelApp.Workbooks.Open "C:\report1\report.xls"  '打开模板
objExcelApp.Workbooks.Add          '新建工作表
objExcelApp.Worksheets("sheet1").Activate
'打开Excel模板
 
 
m=olist.Cols
i=olist.Rows

For j = 1 To m
 For n = 1 To i
  objExcelApp.Worksheets("Sheet1").cells(n,j).value= olist.TextMatrix (n-1,j-1)
 
 Next
Next

objExcelApp.Workbooks.Add
filename= "C:\report1\" & Year(Now) & "年" & Month(Now) & "月" & Day(Now) & "日-" & Hour(Now) & "点" & Minute(Now) & "分" & Second(Now) & "秒生成生产报表.xls"
 objExcelApp.Activeworkbook.saveas (filename)
objExcelApp.Workbooks.Close
objExcelApp.quit
' objExcelApp.Visible = False
'Set ObjExcelApp = Nothing
 'ScreenItems(‘progress’).Visible =False
  'objExcelApp.Workbooks.Add  

 Msgbox "成功导出到C:"

当控件中没有数据时，导出空的EXCEL文件正常，当控件中有数据时，导出的EXCEL文件不能自动保存，文件名也不是按照程序中的命名方式，望高手不吝赐教，万分感激！