按省分别生成excel，按市导入到各自工作表中

wujian123

求助，关于导出按钮代码请问各位老师： 希望通过点击导出按钮，将“档案”中的内容根据“省”导出成不同的excel文件放在桌面上，excel文件的名称就是“省”的名字，在每一个excel文件中又根据不同“城市”分成不同的工作表，且工作表的名称就是“城市”的名字，，谢谢各位老师，小弟感激不尽

[ 本帖最后由 Henry D. Sy 于 2008-12-6 23:47 编辑 ]

wujian123

求哪位老师帮忙

Henry D. Sy

怎么到处重复发帖

wujian123

希望那位老师帮忙，要求比以前的更具体了

Henry D. Sy

原来是要求更高了。
等一会儿帮你改。

wujian123

感激涕零，眼泪哗哗的，谢谢

Henry D. Sy

需要引用
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
   
9. 
   
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
    
19. 
    
20.     For K = 0 To UBound(strProvince)
    
21. 
    
22.         Set xlWrk = xlApp.Workbooks.Add
    
23.         xlWrk.SaveAs CurrentProject.Path & "" & strProvince(K) & ".xls"
    
24. 
    
25.         strCitySQL = "select distinct 省,城市 from 档案 where 省='" & strProvince(K) & "'"
    
26.         rs.Open strCitySQL, CurrentProject.Connection, adOpenKeyset, adLockReadOnly
    
27. 
    
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
    
45. 
    
46.         rs.Close
    
47.         xlWrk.Close
    
48. 
    
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

需要引用
Microsoft Excel 11.0 Object Library是什么意思，具体怎样操作

[ 本帖最后由 wujian123 于 2008-12-6 21:20 编辑 ]

wujian123

谢谢，没问题了

Henry D. Sy

原帖由 wujian123 于 2008-12-6 21:24 发表
谢谢，没问题了

7楼代码有更新
帮你去掉3个多余的工作表