Office中国论坛/Access中国论坛

标题: 按省分别生成excel，按市导入到各自工作表中 [打印本页]
作者: wujian123    时间: 2008-12-6 14:48
标题: 按省分别生成excel，按市导入到各自工作表中
求助，关于导出按钮代码请问各位老师： 希望通过点击导出按钮，将“档案”中的内容根据“省”导出成不同的excel文件放在桌面上，excel文件的名称就是“省”的名字，在每一个excel文件中又根据不同“城市”分成不同的工作表，且工作表的名称就是“城市”的名字，，谢谢各位老师，小弟感激不尽

[ 本帖最后由 Henry D. Sy 于 2008-12-6 23:47 编辑 ]
作者: wujian123    时间: 2008-12-6 15:40
求哪位老师帮忙
作者: Henry D. Sy    时间: 2008-12-6 16:00
怎么到处重复发帖
作者: wujian123    时间: 2008-12-6 16:32
希望那位老师帮忙，要求比以前的更具体了
作者: Henry D. Sy    时间: 2008-12-6 20:21
原来是要求更高了。
等一会儿帮你改。
作者: wujian123    时间: 2008-12-6 20:55
感激涕零，眼泪哗哗的，谢谢
作者: Henry D. Sy    时间: 2008-12-6 21:04
需要引用
Microsoft Excel 11.0 Object Library
  1.     Dim rs As New ADODB.Recordset
  2.     Dim rst As New ADODB.Recordset
  3.     Dim strProvinceSQL As String, strCitySQL As String, SQL As String
  4.     Dim strProvince() As String
  5.     Dim I As Integer, J As Integer, K As Integer
  6.     Dim xlApp As New Excel.Application
  7.     Dim xlWrk As Excel.Workbook
  8.     Dim xlSht As Excel.Worksheet

  10.     strProvinceSQL = "select distinct 省 from 档案"
  11.     rs.Open strProvinceSQL, CurrentProject.Connection, adOpenKeyset, adLockReadOnly
  12.     I = rs.RecordCount - 1
  13.     ReDim strProvince(I) As String
  14.     For J = 0 To I
  15.         strProvince(J) = rs.Fields(0)
  16.         rs.MoveNext
  17.     Next
  18.     rs.Close

  20.     For K = 0 To UBound(strProvince)

  22.         Set xlWrk = xlApp.Workbooks.Add
  23.         xlWrk.SaveAs CurrentProject.Path & "" & strProvince(K) & ".xls"

  25.         strCitySQL = "select distinct 省,城市 from 档案 where 省='" & strProvince(K) & "'"
  26.         rs.Open strCitySQL, CurrentProject.Connection, adOpenKeyset, adLockReadOnly

  28.         Do While Not rs.EOF
  29.             SQL = "select * from 档案 where 省='" & strProvince(K) & "' and 城市='" & rs.Fields(1) & "'"
  30.             rst.Open SQL, CurrentProject.Connection, adOpenKeyset, adLockReadOnly
  31.             xlWrk.Sheets.Add
  32.             Set xlSht = xlWrk.ActiveSheet
  33.             xlSht.Name = rst.Fields(3)
  34.             For J = 1 To 3
  35.                 xlWrk.Worksheets("sheet" & J).Visible = False
  36.             Next
  37.             For I = 0 To rst.Fields.Count - 1
  38.                 xlSht.Cells(1, I + 1) = rst.Fields(I).Name
  39.             Next
  40.             xlSht.Range("A2").CopyFromRecordset rst
  41.             xlWrk.Save
  42.             rst.Close
  43.             rs.MoveNext
  44.         Loop

  46.         rs.Close
  47.         xlWrk.Close

  49.     Next
  50.     Set rst = Nothing
  51.     Set rs = Nothing
  52.     xlApp.Quit
  53.     Set xlApp = Nothing
  54.     MsgBox "OK !!" & vbCrLf & "Saved the files in " & vbCrLf & CurrentProject.Path
复制代码

[ 本帖最后由 Henry D. Sy 于 2008-12-6 23:13 编辑 ]
作者: wujian123    时间: 2008-12-6 21:19
需要引用
Microsoft Excel 11.0 Object Library是什么意思，具体怎样操作

[ 本帖最后由 wujian123 于 2008-12-6 21:20 编辑 ]
作者: wujian123    时间: 2008-12-6 21:24
谢谢，没问题了
作者: Henry D. Sy    时间: 2008-12-6 21:25
原帖由 wujian123 于 2008-12-6 21:24 发表
谢谢，没问题了


7楼代码有更新
帮你去掉3个多余的工作表
作者: wujian123    时间: 2008-12-6 21:40
老师，新生成的文件不是在桌面上，我桌面的地址是C:\Documents and Settings\Administrator\桌面
作者: Henry D. Sy    时间: 2008-12-6 21:47
新生成的文件保存在与数据库文件同一个文件夹中。
这样比较灵活，
如你一定要将它固定死在C:\Documents and Settings\Administrator\桌面，也可以。
更改一下代码中的路径就行了。
作者: Henry D. Sy    时间: 2008-12-6 21:49
就是更改下面这一句，您试着改改。
xlWrk.SaveAs CurrentProject.Path & "\" & strProvince(K) & ".xls"
作者: wujian123    时间: 2008-12-6 22:50
老师，生成的工作表里，只有“编号”、“姓名“两个列名，是不是excel自身的问题

[ 本帖最后由 wujian123 于 2008-12-6 22:52 编辑 ]
作者: Henry D. Sy    时间: 2008-12-6 23:12
非常抱歉
For I = 0 To rs.Fields.Count - 1
      xlSht.Cells(1, I + 1) = rst.Fields(I).Name
Next
上面这句代码中的第一行中的rs漏掉了一个t，应该是rst。也就是
For I = 0 To rst.Fields.Count - 1
       xlSht.Cells(1, I + 1) = rst.Fields(I).Name
Next
作者: wujian123    时间: 2008-12-6 23:23
Thank you very much
作者: changweiren    时间: 2008-12-7 18:47
从中得益,谢谢6D!
作者: 13555609005    时间: 2008-12-30 13:14
学习学习
作者: smz8    时间: 2008-12-31 12:12
求哪位老师帮忙
作者: Yzlszaj    时间: 2009-8-22 03:45
有附件就好了。



欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3