设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 2845|回复: 3
打印 上一主题 下一主题

[窗体] 请大家帮助解决access数据库导出到EXCEL中的数据按照ID排序

[复制链接]
跳转到指定楼层
1#
发表于 2010-9-15 11:24:58 | 显示全部楼层 回帖奖励 |倒序浏览 |阅读模式
5金钱
下面是由access数据库导出到EXCEL中的代码,但是现在有一个问题:无法按照字段名(ID)进行排序使导出数据按照ID进行排序,请大家帮助 谢谢
  1. Private Sub Combo11_AfterUpdate()
  2. Me.Combo13 = ""
  3. Me.Combo13.Requery
  4. End Sub

  5. Private Sub ToParts_Click()
  6. If IsNull(Me.Combo11) Or Me.Combo11 = "" Then
  7. MsgBox "请选择Team!", vbCritical
  8. Me.Combo11.SetFocus
  9. Exit Sub
  10. End If
  11. If IsNull(Me.Combo13) Or Me.Combo13 = "" Then
  12. MsgBox "请选择MPSDATE!", vbCritical
  13. Me.Combo13.SetFocus
  14. Exit Sub
  15. End If



  16. Dim msgTmp As VbMsgBoxResult
  17. msgTmp = MsgBox("确定要导出吗?", vbQuestion + vbYesNo, "Print")
  18. If msgTmp <> vbYes Then Exit Sub
  19. Dim i As Long
  20. Dim c, d As String

  21. Dim xlsAPP As Excel.Application
  22. Dim xlsBook As Excel.Workbook
  23. Dim xlsSheet As Excel.Worksheet
  24. Set xlsAPP = CreateObject("Excel.Application")
  25. xlsAPP.Visible = True
  26. Dim cur_r As Long
  27. Dim dbs As Database
  28. Dim Rst1 As Recordset
  29. Dim strSQL As String
  30. c = Me.Combo11
  31. d = Me.Combo13
  32. Set dbs = CurrentDb
  33. Set Rst1 = dbs.OpenRecordset("SELECT PaiChan_REMOTE.* FROM PaiChan_REMOTE WHERE (((PaiChan_REMOTE.Team)='" & c & "') AND ((PaiChan_REMOTE.Release_Date)=# " & d & " #)) order by PaiChan_REMOTE.RQST;")



  34. Set xlsBook = xlsAPP.Workbooks.OPEN("D:\散件生产计划系统\PaiChanforPI.XLT")

  35. Set xlsSheet = xlsBook.Worksheets("PAICHAN")
  36. xlsSheet.Activate
  37. cur_r = 4


  38. If Rst1.EOF = False Then
  39. xlsSheet.Cells(1, 1) = Rst1!Team

  40. Rst1.MoveFirst
  41. For i = 1 To Rst1.RecordCount
  42. cur_r = cur_r + 1
  43. xlsSheet.Cells(cur_r, 1) = Rst1!CUST_CLAS71
  44. 'xlsSheet.Cells(cur_r, 2) = Rst1!Remark
  45. xlsSheet.Cells(cur_r, 2) = Rst1!id
  46. xlsSheet.Cells(cur_r, 3) = Rst1!CO_NO
  47. xlsSheet.Cells(cur_r, 4) = Rst1!Line_No
  48. xlsSheet.Cells(cur_r, 5) = Rst1!CO_Item
  49. xlsSheet.Cells(cur_r, 6) = Rst1!QTY
  50. xlsSheet.Cells(cur_r, 7) = Rst1!Serial_No
  51. xlsSheet.Cells(cur_r, 8) = Rst1!Desc
  52. xlsSheet.Cells(cur_r, 9) = Rst1!RQST '
  53. xlsSheet.Cells(cur_r, 10) = Rst1!CustAkDt
  54. xlsSheet.Cells(cur_r, 12) = Rst1!Info11
  55. xlsSheet.Cells(1, 12) = Rst1!Release_Date


  56. '........后面自已加


  57. '画格子
  58. With xlsSheet.Range(xlsSheet.Cells(cur_r, 1), xlsSheet.Cells(cur_r, 12)).Borders(xlEdgeLeft)
  59. .LineStyle = xlContinuous
  60. .Weight = xlThin
  61. .ColorIndex = xlAutomatic
  62. End With
  63. With xlsSheet.Range(xlsSheet.Cells(cur_r, 1), xlsSheet.Cells(cur_r, 12)).Borders(xlEdgeTop)
  64. .LineStyle = xlContinuous
  65. .Weight = xlThin
  66. .ColorIndex = xlAutomatic
  67. End With
  68. With xlsSheet.Range(xlsSheet.Cells(cur_r, 1), xlsSheet.Cells(cur_r, 12)).Borders(xlEdgeBottom)
  69. .LineStyle = xlContinuous
  70. .Weight = xlThin
  71. .ColorIndex = xlAutomatic
  72. End With
  73. With xlsSheet.Range(xlsSheet.Cells(cur_r, 1), xlsSheet.Cells(cur_r, 12)).Borders(xlEdgeRight)
  74. .LineStyle = xlContinuous
  75. .Weight = xlThin
  76. .ColorIndex = xlAutomatic
  77. End With
  78. With xlsSheet.Range(xlsSheet.Cells(cur_r, 1), xlsSheet.Cells(cur_r, 12)).Borders(xlInsideVertical)
  79. .LineStyle = xlContinuous
  80. .Weight = xlThin
  81. .ColorIndex = xlAutomatic
  82. End With
  83. Rst1.MoveNext
  84. Next i


  85. End If





  86. Exit_cmdxls_Click:
  87. Exit Sub

  88. Err_cmdxls_Click:
  89. MsgBox err.Description
  90. Resume Exit_cmdxls_Click
  91. End Sub
复制代码

分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅
2#
 楼主| 发表于 2010-9-15 15:52:16 | 显示全部楼层
todaynew 谢谢帮助我改试试!
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-1 06:49 , Processed in 0.085371 second(s), 24 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表