VBA中EXCEL报表的问题！

Question

用如下函数实现报表自动生成时，运行结果对的，但会出现异常，请高手帮忙看看什么原因？代码和异常提示如下：
Private Sub ribao_linshi(time1 As String)Dim strsource1, strsource, strdestination, strdestination1, strdestination2, strdestination3 As StringDim xlapp As Excel.Application
Set xlapp = CreateObject("Excel.Application"): xlapp.Application.Visible = Falsestrdestination = "d:\baobiao\ribao\linshi.xls"
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
If Not fileexists(strdestination) Then
    strsource1 = "d:\template\template2.xls"
    FileCopy strsource1, strdestination
End If
Set xlbook = xlapp.Workbooks.Open(strdestination)
Set xlsheet = xlbook.Sheets(1)If ((time1 >= "07" And time1 <= "09")) Then
xlsheet.Cells(8, 2) = Format(Time, "hh:mm")
xlsheet.Cells(8, 3) = var1
xlsheet.Cells(8, 4) = var2
xlsheet.Cells(8, 5) = var3
xlsheet.Cells(8, 6) = var4
xlsheet.Cells(8, 7) = var5
xlbook.Save
End IfIf ((time1 >= "15" And time1 <= "17")) Then
xlsheet.Cells(9, 2) = Format(Time, "hh:mm")
xlsheet.Cells(9, 3) = var6
xlsheet.Cells(9, 4) = var7
xlsheet.Cells(9, 5) = var8
xlsheet.Cells(9, 6) = var9
xlsheet.Cells(9, 7) = var10
xlbook.Save
End IfIf ((time1 >= "00" And time1 <= "01") Or (time1 >= "23")) Then
    xlsheet.Cells(10, 2) = Format(Time, "hh:mm")
    xlsheet.Cells(10, 3) = var11
    xlsheet.Cells(10, 4) = var12
    xlsheet.Cells(10, 5) = var13
    xlsheet.Cells(10, 6) = var14
    xlsheet.Cells(10, 7) = var15
    'xlbook.Save
    '写日报
    xlsheet.Cells(8, 1) = Format(Date, "yyyy.mm.dd")
    xlsheet.Cells(11, 3) = xlsheet.Cells(8, 3) + xlsheet.Cells(9, 3) + xlsheet.Cells(10, 3)
    xlsheet.Cells(11, 4) = xlsheet.Cells(8, 4) + xlsheet.Cells(9, 4) + xlsheet.Cells(10, 4)
    xlsheet.Cells(11, 5) = xlsheet.Cells(8, 5) + xlsheet.Cells(9, 5) + xlsheet.Cells(10, 5)
    xlsheet.Cells(11, 6) = xlsheet.Cells(8, 6) + xlsheet.Cells(9, 6) + xlsheet.Cells(10, 6)
    xlsheet.Cells(11, 7) = xlsheet.Cells(8, 7) + xlsheet.Cells(9, 7) + xlsheet.Cells(10, 7)
    'xlbook.Save
    xlbook.SaveAs ("d:\baobiaoku\ribao\" + Format(Date, "yyyy_mm_dd") + ".xls")
    If fileexists(strdestination) Then
    Kill (strdestination)
    End If
  End If
If ((time1 >= "00" And time1 <= "01") Or (time1 >= "23")) Then
    '写月报
    Dim xlbook1 As Excel.Workbook
    Dim xlsheet1 As Excel.Worksheet
    Dim dest1 As String
    dest1 = "d:\baobiaoku\yuebao\" + Format(Date, "yyyy_mm") + ".xls"
    If Not fileexists(dest1) Then
        strsource1 = "d:\template\template3.xls"
        FileCopy strsource1, dest1
    End If
    Set xlbook1 = xlapp.Workbooks.Open(dest1)
    Set xlsheet1 = xlbook1.Sheets(1)    
    '判断哪一行
    Dim rowflag As Integer
    rowflag = Format(Date, "dd")
    xlsheet1.Cells(rowflag + 4, 3) = xlsheet.Cells(11, 3)
    xlsheet1.Cells(rowflag + 4, 4) = xlsheet.Cells(11, 4)
    xlsheet1.Cells(rowflag + 4, 5) = xlsheet.Cells(11, 5)
    xlsheet1.Cells(rowflag + 4, 6) = xlsheet.Cells(11, 6)
    xlsheet1.Cells(rowflag + 4, 7) = xlsheet.Cells(11, 7)
        xlsheet1.Cells(36, 3) = xlsheet1.Cells(36, 3) + xlsheet1.Cells(rowflag + 4, 3) '计算总量
        xlsheet1.Cells(36, 4) = xlsheet1.Cells(36, 4) + xlsheet1.Cells(rowflag + 4, 4)
        xlsheet1.Cells(36, 5) = xlsheet1.Cells(36, 5) + xlsheet1.Cells(rowflag + 4, 5)
        xlsheet1.Cells(36, 6) = xlsheet1.Cells(36, 6) + xlsheet1.Cells(rowflag + 4, 6)
        xlsheet1.Cells(36, 7) = xlsheet1.Cells(36, 7) + xlsheet1.Cells(rowflag + 4, 7)
        xlsheet1.Cells(5, 1) = Format(Date, "yyyy_mm")
    xlbook1.SaveEnd If
   
xlapp.QuitSet xlapp = Nothing
Set xlbook = Nothing
Set xlsheet = Nothing
Set xlbook1 = Nothing
Set xlsheet1 = Nothing
End Sub单步调试时，异常出现在倒数第三行“Set xlbook1 = Nothing”，异常提示为“Excel产生了错误，会被Windows关闭，您需要重新启动程序。正在创建错误日志”，请大侠帮忙看看错误在哪里，由于我不大懂VBA，很多代码写的不规范，请指教。

Answer 1

下面的vb对excel操作的方法,你看看是否对你有些帮助
1．创建Excel对象　　eole=CREATEOBJECT(′Excel.application′)　　2．添加新工作簿　　eole.Workbooks.add　　3．设置第3个工作表为激活工作表　　eole.Worksheets(″sheet3″).Activate　　4．打开指定工作簿　　eole.Workbooks.Open(″c:\temp\ll.xls″)　　5．显示Excel窗口　　eole.visible=.t.　　6．更改Excel标题栏　　eole.Caption=″VFP应用程序调用Microsoft Excel″　　7．给单元格赋值　　eole.cells(1,4).value=XM(XM为数据库字段名)　　8．设置指定列的宽度(单位：字符个数)　　eole.ActiveSheet.Columns(1).ColumnWidth=5　　9．设置指定行的高度(单位：磅)　　eole.ActiveSheet.Rows(1).RowHeight=1/0.035　　(设定行高为1厘米，1磅=0.035厘米)　　10．在第18行之前插入分页符　　eole.Worksheets(″Sheet1″).Rows(18).PageBreak=1　　11．在第4列之前删除分页符　　eole.ActiveSheet.Columns(4).PageBreak=0　　12．指定边框线宽度(Borders参数如下)　　ole.ActiveSheet.Range(″b3:d3″).Borders(2).Weight=3　　13．设置四个边框线条的类型　　eole.ActiveSheet.Range(″b3:d3″).Borders(2).LineStyle=1　　(其中Borders参数：1－左、2－右、3－顶、4－底、5－斜、6－斜/；LineStyle值：1与7－细实、2－细虚、4－点虚、9－双细实线)　　14．设置页眉　　eole.ActiveSheet.PageSetup.CenterHeader=″报表1″　　15．设置页脚　　eole.ActiveSheet.PageSetup.CenterFooter=″第＆P页″　　16．设置页眉到顶端边距为2厘米　　eole.ActiveSheet.PageSetup.HeaderMargin=2/0.035　　17．设置页脚到底边距为3厘米　　eole.ActiveSheet.PageSetup.FooterMargin=3/0.035　　18．设置顶边距为2厘米　　eole.ActiveSheet.PageSetup.TopMargin=2/0.035　　19．设置底边距为4厘米　　eole.ActiveSheet.PageSetup.BottomMargin=4/0.035　　20．设置左边距为2厘米　　veole.ActiveSheet.PageSetup.LeftMargin=2/0.035　　21．设置右边距为2厘米　　eole.ActiveSheet.PageSetup.RightMargin=2/0.035　　22．设置页面水平居中　　eole.ActiveSheet.PageSetup.CenterHorizontally=.t.　　23．设置页面垂直居中　　eole.ActiveSheet.PageSetup.CenterVertically=.t.　　24．设置页面纸张大小(1－窄行8511 39－宽行1411)　　eole.ActiveSheet.PageSetup.PaperSize=1　　25．打印单元格网线　　eole.ActiveSheet.PageSetup.PrintGridlines=.t.　　26．拷贝整个工作表　　eole.ActiveSheet.UsedRange.Copy　　27．拷贝指定区域　　eole.ActiveSheet.Range(″A1:E2″).Copy　　28．粘贴　　eole.WorkSheet(″Sheet2″).Range(″A1″).PasteSpecial　　29．在第2行之前插入一行　　eole.ActiveSheet.Rows(2).Insert　　30．在第2列之前插入一列　　eole.ActiveSheet.Columns(2).Insert　　31．设置字体　　eole.ActiveSheet.Cells(2,1).Font.Name=″黑体″　　32．设置字体大小　　eole.ActiveSheet.Cells(1,1).Font.Size=25　　33．设置字体为斜体　　eole.ActiveSheet.Cells(1,1).Font.Italic=.t.　　34．设置整列字体为粗体　　eole.ActiveSheet.Columns(1).Font.Bold=.t.　　35．清除单元格公式　　eole.ActiveSheet.Cells(1,4).ClearContents　　36．打印预览工作表　　eole.ActiveSheet.PrintPreview　　37．打印输出工作表　　eole.ActiveSheet.PrintOut　　38．工作表另为　　eole.ActiveWorkbook.SaveAs(″c:\temp\22.xls″)　　39．放弃存盘　　eole.ActiveWorkbook.saved=.t.　　40．关闭工作簿　　eole.Workbooks.close　　41．退出Excel　　eole.quit

Answer 2

单步调试时，异常出现在倒数第三行“Set xlbook1 = Nothing”，异常提示为“Excel产生了错误，会被Windows关闭，您需要重新启动程序。正在创建错误日志”，请大侠帮忙看看错误在哪里
-------------------------------
你先关闭，然后再释放试试：
....
xlbook.Close
xlbook1.Close
xlapp.QuitSet xlapp = Nothing
Set xlbook = Nothing
Set xlsheet = Nothing
Set xlbook1 = Nothing
Set xlsheet1 = Nothing

Answer 3

faysky2(),谢谢你的答复，我去试试。如果把下面几句都去掉，不释放，长期运行会出现问题吗？
Set xlapp = Nothing
Set xlbook = Nothing
Set xlsheet = Nothing
Set xlbook1 = Nothing
Set xlsheet1 = Nothing

Answer 4

还请高手指点。上面代码在我办公室的计算机上一般不会出现异常，只是偶尔出现，在现场的计算机上几乎每次调用函数时都出现异常，也不影响生成的报表，就是弹出个异常窗口。现场的计算机上还有其他操作EXCEL写报表的模块，都是定时调用的。

Answer 5

faysky2() ,按你说的方法修改了，还是出现异常，异常出现在xlbook.Close这句上面，异常的提示与原来不一样。 麻烦您在帮忙看一下是程序的原因还是跟操作系统有关。给系统中运行的其他程序模块有没有关系，也有其他程序模块在操作EXCEL。其他高手也可以给我意见啊，比较着急，分数可以再加！

Answer 6

照着我的程序做,不会错的
Private Sub cmdExcel_Click()
 On Error GoTo ErrHandler
   Dim strsql As String
   Dim strsql_db As String
   Dim jhze As Double
   Dim fkze As Double
   Dim wczcje As Double
   Dim yfkje As Double
   Dim fkje As Double
   Dim ce As Double
   
   If Text1.Text = "" Then
      MsgBox "查询的年份不能为空！", 48, "信息"
      Exit Sub
   End If
   
   If Text2.Text = "" Then
      MsgBox "请查询数据！", 48, "信息"
      Exit Sub
   End If
   
   Set xlapp1 = CreateObject("excel.application")              'create the excel object
   xlapp1.Workbooks.Open (App.Path & "\按单位查询模板.xls")          'FileName changed
   xlapp1.Workbooks("按单位查询模板.xls").Activate
     
   xlapp1.Worksheets(1).Cells(1, 1) = Text1.Text & "年按单位统计的完成资产统计表"
   
   
   strsql = Text2.Text
   Set rs = ExecuteSQL(strsql, msgtext)
   For i = 6 To rs.RecordCount + 5
       xlapp1.ActiveSheet.Rows(i).Insert
       xlapp1.Worksheets(1).Cells(i, 1) = i - 5
       xlapp1.Worksheets(1).Cells(i, 2) = rs.Fields("单位名称")
       xlapp1.Worksheets(1).Cells(i, 3) = rs.Fields("计划总额")
       xlapp1.Worksheets(1).Cells(i, 4) = rs.Fields("付款总额")
       xlapp1.Worksheets(1).Cells(i, 5) = rs.Fields("完成资产金额")
       xlapp1.Worksheets(1).Cells(i, 6) = rs.Fields("预付款金额")
       xlapp1.Worksheets(1).Cells(i, 7) = rs.Fields("付款金额")
       xlapp1.Worksheets(1).Cells(i, 8) = rs.Fields("差额")
       jhze = jhze + rs.Fields("计划总额")
       wczcje = jhje + rs.Fields("完成资产金额")
       yfkje = jhje + rs.Fields("预付款金额")
       fkje = fkje + rs.Fields("付款金额")
       fkze = fkze + rs.Fields("付款总额")
       ce = ce + rs.Fields("差额")
       rs.MoveNext
   Next i
   xlapp1.ActiveSheet.Rows(5).Delete
   xlapp1.Worksheets(1).Cells(4, 3) = jhze
   xlapp1.Worksheets(1).Cells(4, 4) = fkze
   xlapp1.Worksheets(1).Cells(4, 5) = wczcje
   xlapp1.Worksheets(1).Cells(4, 6) = yfkje
   xlapp1.Worksheets(1).Cells(4, 7) = fkje
   xlapp1.Worksheets(1).Cells(4, 8) = ce
   With CommonDialog1
         .DialogTitle = "生成Excel"
         .FileName = "*.xls"
         .Filter = "(Excel)*.xls|*.xls"
         .CancelError = True
         .ShowOpen
       '.ShowSave
   End With
      'xlapp1.Save
   xlapp1.ActiveWorkbook.SaveAs (CommonDialog1.FileName)
   
   xlapp1.Quit
   MsgBox "数据导Excel完成！", 48, "信息"
   rs.Close
   Set rs = Nothing
   Exit Sub
ErrHandler:
   '用户按了“取消”按钮
   MsgBox "用户取消从Excel导出数据操作！", 48, "提示"
   Exit Sub
End Sub'这个是执行sql语句函数
Public Function ExecuteSQL(ByVal sql As String, MsgString As String) As ADODB.Recordset
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim sTokens() As String
    'Dim SQL As String
    On Error GoTo ExecuteSQL_Error
    sTokens = Split(sql)
    Set cnn = New ADODB.Connection
    cnn.Open ConnectString
    If InStr("INSERT,DELETE,UPDATE", UCase$(sTokens(0))) Then
       cnn.Execute sql
       MsgString = sTokens(0) & "query successful"
    Else
       Set rst = New ADODB.Recordset
       rst.Open Trim$(sql), cnn, adOpenKeyset, adLockOptimistic
      
       
       Set ExecuteSQL = rst
        
       MsgString = "查询到" & rst.RecordCount & "条纪录"
    End If
ExecuteSQL_Exit:
    Set rst = Nothing
    Exit Function
    Set cnn = Nothing
ExecuteSQL_Error:
    MsgString = "查询错误:" & Err.Description
    Resume ExecuteSQL_Exit
End FunctionPublic Function ConnectString() As String
    ConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\计划管理系统.mdb;Persist Security Info=False"
    
End Function

Answer 7

我认为你的这个问题应该是关闭进程和释放对象的问题！如果你没有执行最后一个判断的（打印月报那个地方）话那你就不用在最后Set xlbook1 = Nothing，Set xlsheet1 = Nothing了。所以我认为你应该对关闭进程和释放对象进行判断处理！

Answer 8

有几个测试方案，看看反应如何？：方案1：
在 xlbook.SaveAs ("d:\baobiaoku\ribao\" + Format(Date, "yyyy_mm_dd") + ".xls")之后
加入Set xlsheet = xlbook.Sheets(1)
(再绑定一次引用...，看看...如何）方案2：
在xlapp.Quit之前加入xlApp.DisplayAlerts = False
（因为当workbook.saved=false时，退出系统会弹出问你是否保存的对话框，而你前面
  设置了xlapp.Application.Visible = False）方案3：
去掉Set xlbook1 = Nothing，看看如何
（好像有资料表明：sub的局部变量在退出sub之前，vb会聪明的自动清除，如果是object
  的话，也会自动的释放引用，对于该对象就是做refrence＝refrence-1，所以我怀疑...）问：
1. d:\template\template3.xls有没有其它进程在读写？建议：
1. 在出错后，要打开任务管理器看看application真正退出了没有，因为你用了：
   xlapp.Application.Visible = False，如果没有真正退出的话，下次就......
2. 把“xlsheet1.Cells(36, 3) = ”改为“xlsheet1.Cells(36, 3).value =”
暂时想到这些...

Answer 9

很感谢 wanghuibing和 flili两位大侠，我下次到现场去按你们的方法调试，把出现的问题再反馈给你们。
flili，我办公室调试，出现异常时，打开任务管理器发现有EXCEL进程，有时候看到任务管理器中出现好几个EXCEL进程。 另外，d:\template\template3.xls没有其它进程在读写。

Answer 10

问题解决
问题原因是释放顺序不对，把Set xlapp = Nothing最后释放就可以了。非常感谢几位大虾的帮助，你们的答复使我学到很多东西。揭贴