Office中国论坛/Access中国论坛

标题: 极品代码，抛砖引玉并请求指教！ [打印本页]

作者: LittleBoy 时间: 2002-8-2 06:20
标题: 极品代码，抛砖引玉并请求指教！
以下代码实现了从ACCESS向EXCEL导出指定表指定字段的数据，在ACCESS2000中成功通过测试。
美中不足的是：
1、下面代码的执行是在EXCEL表（路径为：D:\center\SalesComTop100.xls）关闭时运行的，我希望能在EXCEL表（路径为：D:\center\SalesComTop100.xls）在打开状态下运行，即向EXCEL表导出数据。
2、在EXCEL表（路径为：D:\center\SalesComTop100.xls）中有一个宏：abc,如何使它运行啊？即ACCESS导出数据完毕后，程序自动执行EXCEL（路径为：D:\center\SalesComTop100.xls）中的宏abc。我个人认为应可写在下面的代码中，只是不知如何执行宏abc。

Function output()
Dim exapp As Excel.Application
Dim Book As Excel.Workbook
Dim ws As Worksheet
Dim com As Worksheet
Dim i As Integer
Dim j As Integer
DoCmd.SetWarnings False

DoCmd.RunSQL "SELECT QueTop100.* INTO TabDataComTop100 FROM QueTop100;"
DoCmd.RunSQL "SELECT QueCusTop100.* INTO TabDataCompany FROM QueCusTop100;"

Set exapp = New Excel.Application
Set ws = exapp.Workbooks.Open("D:\center\SalesComTop100.xls").Worksheets("Data")
Dim rst1 As DAO.Recordset
Dim rst2 As DAO.Recordset

Set rst1 = CurrentDb.OpenRecordset("TabDataComTop100", dbOpenDynaset)
Set rst2 = CurrentDb.OpenRecordset("TabDataCompany", dbOpenDynaset)
For i = 6 To 500'用于清除EXCEL表中的数据。
      If ws.Cells(i, 1) = "" Then GoTo 10
         For j = 1 To 29
            ws.Cells(i, j) = ""
         Next j

Next i
10 i = 5

rst1.MoveFirst
Do Until rst1.EOF
      i = i + 1
      ws.Cells(i, 1) = rst1("品  种")
      ws.Cells(i, 2) = rst1("规  格")
      ws.Cells(i, 3) = rst1("总销量")
      ws.Cells(i, 4) = rst1("一月")
      ws.Cells(i, 5) = rst1("二月")
      ws.Cells(i, 6) = rst1("三月")
      ws.Cells(i, 7) = rst1("四月")
      ws.Cells(i, 8) = rst1("五月")
      ws.Cells(i, 9) = rst1("六月")
      ws.Cells(i, 10) = rst1("七月")
      ws.Cells(i, 11) = rst1("八月")
      ws.Cells(i, 12) = rst1("九月")
      ws.Cells(i, 13) = rst1("十月")
      ws.Cells(i, 14) = rst1("十一月")
      ws.Cells(i, 15) = rst1("十二月")
      rst1.MoveNext
Loop
j = 5
rst2.MoveFirst
Do Until rst2.EOF
      j = j + 1
      ws.Cells(j, 16) = rst2("单  位")
      ws.Cells(j, 17) = rst2("累计")
      ws.Cells(j, 18) = rst2("一月")
      ws.Cells(j, 19) = rst2("二月")
      ws.Cells(j, 20) = rst2("三月")
      ws.Cells(j, 21) = rst2("四月")
      ws.Cells(j, 22) = rst2("五月")
      ws.Cells(j, 23) = rst2("六月")
      ws.Cells(j, 24) = rst2("七月")
      ws.Cells(j, 25) = rst2("八月")
      ws.Cells(j, 26) = rst2("九月")
      ws.Cells(j, 27) = rst2("十月")
      ws.Cells(j, 28) = rst2("十一月")
      ws.Cells(j, 29) = rst2("十二月")
      rst2.MoveNext
Loop

' exapp.Workbooks("SalesComTop100.xls").Save

'exapp.Workbooks("SalesComTop100.xls").Close
exapp.Visible = True

Set exapp = Nothing
Set Book = Nothing
End Function

作者: 竹笛 时间: 2002-8-2 14:49
好东东，值得珍藏！

作者: make 时间: 2002-8-2 17:06
good ,very good

作者: 明莱 时间: 2002-8-2 17:47
You have done well.

作者: LittleBoy 时间: 2002-8-2 20:04
哪位老师帮忙解决一下美中不足的两个问题，真的很简单，就是只有我不会，谢谢！

作者: HG 时间: 2002-8-2 23:22
DTS

作者: 明莱 时间: 2002-8-3 00:42
1、Set xlBook = xlApp.Workbooks.Open("Excel文件名")
2、xlApp.Run "宏名"

作者: LittleBoy 时间: 2002-8-3 03:47
谢谢明莱老师！
xlApp.Run "宏名" 已解决
但下面这还是没搞定：
Set xlBook = xlApp.Workbooks.Open("Excel文件名")
是不是：Set exapp = New Excel.Application也不要的？

作者: 明莱 时间: 2002-8-3 05:00

, 这句不能没有,不然ACCESS怎么知道 xlApp是什么呢?
Set xlApp=New Excel.Application, 我使用的是微软帮助里的命名方法.exapp是你自己想的吧,命名最好能和大家一致.
Ps.我发现你使用了GOTO语句,这也许有时会很方便,但是编出来的程序结构不严紧,这是ACCESS入门者应该避免了,打好基础, 以后学起来就容易.

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)