关于隐藏列与导出

qp370982

各位老师，如何在导出文档为excel，不显示隐藏的列

huangxiuwen

学习

Henry D. Sy

代码不能生搬硬套，要看你的实际情况
原代码是用在有省有市的情况下，

qp370982

老师，首先谢谢您，happy new year
可是我发现一个问题，当我再lizi的表中增加一行，结果就不能导出了。（“籍贯“增加了一项内容，”籍贯”、“政治面貌”、“名族”等列的种类是会随时间不断变化的）

Henry D. Sy

忘了，更改字段数量。
现修正在13楼。

Henry D. Sy

原帖由 qp370982 于 2008-12-31 23:42 发表
那怎样设置路径保存为对话框形式

[ 本帖最后由 Henry D. Sy 于 2009-1-1 07:15 编辑 ]

qp370982

那怎样设置路径保存为对话框形式

Henry D. Sy

这个例子中，既然序号是多余的，就不要放到子窗体上去。

qp370982

请在帮你忙改改这个
要求：1、窗体1中有一列“序号”是隐藏列，希望在导出的excel文件中能够不显示这一列
           2、能不能把设置保存路径的方式改为对话框
谢谢

Henry D. Sy

Dim ctl As Control
Private Sub Command13_Click()
    Dim Qdf As DAO.QueryDef
    Dim rs As New ADODB.Recordset
    Dim strSQL As String, strCriteria As String
    Dim strPath As String
    Dim diaFs As FileDialog
    Set diaFs = Application.FileDialog(msoFileDialogSaveAs)
    With diaFs
        .Title = "导出为........"
        .Show
    End With
    If diaFs.SelectedItems.Count > 0 Then
        strPath = diaFs.SelectedItems(1)
    End If
    If strPath = "" Then
        strPath = CurrentProject.Path & "\out.xls"
    ElseIf Right(strPath, 4) <> ".xls" Then
        strPath = strPath & ".xls"
    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
        Set Qdf = CurrentDb.QueryDefs("Out")
        .Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
        Do While Not .EOF

            strSQL = "SELECT 姓名, 性别, 籍贯, 政治面貌, 名族 from 表1 where 籍贯='" & .Fields(0) & "'"
            Qdf.SQL = strSQL
            DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Out", strPath, , .Fields(0)
            .MoveNext
        Loop
        .Close
    End With
    Set rs = Nothing
    Set Qdf = Nothing
    Set diaFs = Nothing
End Sub