VBA中EXCEL报表的问题!

lcj49997 2005-10-15 02:35:18
用如下函数实现报表自动生成时,运行结果对的,但会出现异常,请高手帮忙看看什么原因?代码和异常提示如下:
Private Sub ribao_linshi(time1 As String)

Dim strsource1, strsource, strdestination, strdestination1, strdestination2, strdestination3 As String

Dim xlapp As Excel.Application
Set xlapp = CreateObject("Excel.Application"): xlapp.Application.Visible = False

strdestination = "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 If

If ((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 If

If ((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.Save

End If

xlapp.Quit

Set xlapp = Nothing
Set xlbook = Nothing
Set xlsheet = Nothing
Set xlbook1 = Nothing
Set xlsheet1 = Nothing
End Sub

单步调试时,异常出现在倒数第三行“Set xlbook1 = Nothing”,异常提示为“Excel产生了错误,会被Windows关闭,您需要重新启动程序。正在创建错误日志”,请大侠帮忙看看错误在哪里,由于我不大懂VBA,很多代码写的不规范,请指教。
...全文
517 11 打赏 收藏 转发到动态 举报
写回复
用AI写文章
11 条回复
切换为时间正序
请发表友善的回复…
发表回复
lcj49997 2005-10-31
  • 打赏
  • 举报
回复
问题解决
问题原因是释放顺序不对,把Set xlapp = Nothing最后释放就可以了。

非常感谢几位大虾的帮助,你们的答复使我学到很多东西。揭贴
lcj49997 2005-10-25
  • 打赏
  • 举报
回复
很感谢 wanghuibing和 flili两位大侠,我下次到现场去按你们的方法调试,把出现的问题再反馈给你们。
flili,我办公室调试,出现异常时,打开任务管理器发现有EXCEL进程,有时候看到任务管理器中出现好几个EXCEL进程。 另外,d:\template\template3.xls没有其它进程在读写。
flili 2005-10-24
  • 打赏
  • 举报
回复

有几个测试方案,看看反应如何?:

方案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 =”


暂时想到这些...


wanghuibing 2005-10-23
  • 打赏
  • 举报
回复
我认为你的这个问题应该是关闭进程和释放对象的问题!如果你没有执行最后一个判断的(打印月报那个地方)话那你就不用在最后Set xlbook1 = Nothing,Set xlsheet1 = Nothing了。所以我认为你应该对关闭进程和释放对象进行判断处理!
上官云峰 2005-10-18
  • 打赏
  • 举报
回复
照着我的程序做,不会错的
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 Function

Public Function ConnectString() As String
ConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\计划管理系统.mdb;Persist Security Info=False"

End Function
lcj49997 2005-10-17
  • 打赏
  • 举报
回复
faysky2() ,按你说的方法修改了,还是出现异常,异常出现在xlbook.Close这句上面,异常的提示与原来不一样。 麻烦您在帮忙看一下是程序的原因还是跟操作系统有关。给系统中运行的其他程序模块有没有关系,也有其他程序模块在操作EXCEL。

其他高手也可以给我意见啊,比较着急,分数可以再加!
lcj49997 2005-10-16
  • 打赏
  • 举报
回复
还请高手指点。

上面代码在我办公室的计算机上一般不会出现异常,只是偶尔出现,在现场的计算机上几乎每次调用函数时都出现异常,也不影响生成的报表,就是弹出个异常窗口。现场的计算机上还有其他操作EXCEL写报表的模块,都是定时调用的。
faysky2 2005-10-15
  • 打赏
  • 举报
回复
如果把下面几句都去掉,不释放,长期运行会出现问题吗?
------------------
如果不释放,你多次调用这个过程的时候,每次都会增加内存的使用,那样会耗掉你的内存,一般都要释放的
lcj49997 2005-10-15
  • 打赏
  • 举报
回复
faysky2(),谢谢你的答复,我去试试。

如果把下面几句都去掉,不释放,长期运行会出现问题吗?
Set xlapp = Nothing
Set xlbook = Nothing
Set xlsheet = Nothing
Set xlbook1 = Nothing
Set xlsheet1 = Nothing
faysky2 2005-10-15
  • 打赏
  • 举报
回复
单步调试时,异常出现在倒数第三行“Set xlbook1 = Nothing”,异常提示为“Excel产生了错误,会被Windows关闭,您需要重新启动程序。正在创建错误日志”,请大侠帮忙看看错误在哪里
-------------------------------
你先关闭,然后再释放试试:
....
xlbook.Close
xlbook1.Close
xlapp.Quit

Set xlapp = Nothing
Set xlbook = Nothing
Set xlsheet = Nothing
Set xlbook1 = Nothing
Set xlsheet1 = Nothing
上官云峰 2005-10-15
  • 打赏
  • 举报
回复
下面的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

2,461

社区成员

发帖
与我相关
我的任务
社区描述
VBA(Visual Basic for Applications)是Visual Basic的一种宏语言,是在其桌面应用程序中执行通用的自动化(OLE)任务的编程语言。
社区管理员
  • VBA
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧