Office中国论坛/Access中国论坛

标题: 求导出按钮代码 [打印本页]
作者: qp370982    时间: 2008-12-22 19:01
标题: 求导出按钮代码
各位老师：
           单选按钮是与籍贯列的内容相对应的，将选中的单选按钮（籍贯）相对应的内容导出为excel
要求：1、都在一个excel文件中，但不同的籍贯为不同的不同的工作表2、工作表的名子就是籍贯名
3、能够自己设定导出excel文件的保存路径

[ 本帖最后由 qp370982 于 2008-12-22 19:12 编辑 ]
作者: qp370982    时间: 2008-12-22 20:40
那位老师帮帮我，谢谢，感激涕零
作者: qp370982    时间: 2008-12-22 23:28
那位老师帮帮我，谢谢，感激涕零
作者: Henry D. Sy    时间: 2008-12-23 08:31
http://www.office-cn.net/forum.p ... mp;page=2#pid389904
作者: yesterday    时间: 2008-12-23 08:40
我想这样作可能好一些：因为导入方法是对表操作的，所以你首先要把筛选结果临时放在一个表或查询中。假定临时表为temp，在导出按钮中加入sql，delete * from temp
"insert into temp selete * from 表1 where 籍贯= 选项值
然后采用 TransferSpreadsheet方法
作者: yesterday    时间: 2008-12-23 08:48
版主 的帖子很厉害，强烈建议参考使用
作者: qp370982    时间: 2008-12-23 13:06
求老师帮忙给改改，在下没学过vb，只学过c，这是老板要的，谢谢，
作者: qp370982    时间: 2008-12-23 13:43
求老师帮忙给改改，在下没学过vb，只学过c，这是老板要的，谢谢，
作者: Henry D. Sy    时间: 2008-12-23 20:29
Private Sub Command13_Click()
    Dim Qdf As DAO.QueryDef
    Dim rs As New ADODB.Recordset
    Dim strSQL As String, strCriteria As String
    Dim ctl As Control

    If IsNull(Me.Text14) Then
        MsgBox "Enter the Path frist"
        Me.Text14.SetFocus
        Exit Sub
    End If
    Set Qdf = CurrentDb.QueryDefs("Q")
    For Each ctl In Me.Controls
        If TypeOf ctl Is OptionButton Then
            If ctl Then
                strCriteria = strCriteria & "'" & ctl.Name & "',"
            End If
        End If
    Next
    If strCriteria = "" Then
        strSQL = "select * from 表1 order by 籍贯"
    Else
        strSQL = "select * from 表1 where 籍贯  in (" & strCriteria & ") order by 籍贯"
    End If
    Qdf.SQL = strSQL
    strSQL = "select distinct 籍贯 from Q"
    With rs
        .Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
        Do While Not .EOF
            Set Qdf = CurrentDb.QueryDefs("Out")
            strSQL = "select * from 表1 where 籍贯='" & .Fields(0) & "'"
            Qdf.SQL = strSQL
            DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Out", Me.Text14, , .Fields(0)
            .MoveNext
        Loop
        .Close
    End With
    Set rs = Nothing
    Set Qdf = Nothing
End Sub

[ 本帖最后由 Henry D. Sy 于 2008-12-23 20:31 编辑 ]
作者: qp370982    时间: 2008-12-23 23:42
保存路径能设置为对话框形式吗，谢谢
作者: Henry D. Sy    时间: 2008-12-24 08:10
  1. Dim ctl As Control
  2. Private Sub Command13_Click()
  3.     Dim Qdf As DAO.QueryDef
  4.     Dim rs As New ADODB.Recordset
  5.     Dim strSQL As String, strCriteria As String
  6.     Dim strPath As String
  7.     Dim diaFs As FileDialog
  8.     Set diaFs = Application.FileDialog(msoFileDialogSaveAs)
  9.     With diaFs
  10.         .Title = "导出为........"
  11.         .Show
  12.     End With
  13.     If diaFs.SelectedItems.Count > 0 Then
  14.         strPath = diaFs.SelectedItems(1)
  15.     End If
  16.     If strPath = "" Then
  17.         strPath = CurrentProject.Path & "\out.xls"
  18.     ElseIf Right(strPath, 4) <> ".xls" Then
  19.         strPath = strPath & ".xls"
  20.     End If
  21.     Set Qdf = CurrentDb.QueryDefs("Q")
  22.     For Each ctl In Me.Controls
  23.         If TypeOf ctl Is OptionButton Then
  24.             If ctl Then
  25.                 strCriteria = strCriteria & "'" & ctl.Name & "',"
  26.             End If
  27.         End If
  28.     Next
  29.     If strCriteria = "" Then
  30.         strSQL = "select * from 表1 order by 籍贯"
  31.     Else
  32.         strSQL = "select * from 表1 where 籍贯 in (" & strCriteria & ") order by 籍贯"
  33.     End If
  34.     Qdf.SQL = strSQL
  35.     strSQL = "select distinct 籍贯 from Q"
  36.     With rs
  37.         Set Qdf = CurrentDb.QueryDefs("Out")
  38.         .Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
  39.         Do While Not .EOF

  41.             strSQL = "select * from 表1 where 籍贯='" & .Fields(0) & "'"
  42.             Qdf.SQL = strSQL
  43.             DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Out", strPath, , .Fields(0)
  44.             .MoveNext
  45.         Loop
  46.         .Close
  47.     End With
  48.     Set rs = Nothing
  49.     Set Qdf = Nothing
  50.     Set diaFs = Nothing
  51. End Sub

  53. Private Sub Form_Load()
  54.     For Each ctl In Me.Controls
  55.         If TypeOf ctl Is OptionButton Then
  56.             ctl = False
  57.         End If
  58.     Next
  59. End Sub
复制代码

[ 本帖最后由 Henry D. Sy 于 2008-12-24 08:11 编辑 ]
作者: qp370982    时间: 2008-12-24 11:26
Dim diaFs As FileDialog提示用户定义类型未定义
作者: Henry D. Sy    时间: 2008-12-24 11:29
需要引用 Microsoft Office 11



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