专家坐堂-关于折叠表的导出问题Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

Dim ckl As WinForm.CheckedListBox = e.Form.Controls("lbk")

Dim nms As New List(Of String)

For i As Integer = 0 To ckl.Items.count - 1 \'获取已经勾选的列

If ckl.GetItemChecked(i) Then

nms.Add(ckl.Items(i))

End If

If nms.Count = 0 Then

MessageBox.Show("至少要选择一列", "提示", MessageBoxButtons.OK, MessageBoxIcon.Information)

Return

End If

Dim dlg As New SaveFileDialog

dlg.filter = "Excel文件|*.xls"

dlg.OverwritePrompt = True \'弹出覆盖警告

If dlg.ShowDialog = DialogResult.OK Then

Dim cmd As New SQLCommand

Dim Book As New XLS.Book()

Dim Sheet As XLS.Sheet

Dim dt As DataTable

For Each nm As String In nms

Sheet = Book.Sheets.Add(nm) \'增加一个工作表

If e.Form.Controls("导出理论数据").Checked = True Then

cmd.CommandText = "sele ct 序号,科目编码,项目构成,单位,用量 as 理论用量 ,单价 as 理论单价,合价 as 理论合价,备注 from {" & nm & "}" \'该行代码不能加主键，否则出错

Else If e.Form.Controls("导出投标数据").Checked = True Then

cmd.CommandText = "sel ect 序号, 科目编码, 项目构成,单位,报价调整1 as 投标用量,报价调整2 as 投标单价,报价调整3 as 投标合价 ,备注 from {" & nm & "}" \'该行代码不能加主键，否则出错

Else If e.Form.Controls("导出理论数据").Checked = False And e.Form.Controls("导出投标数据").Checked = False Then

MessageBox.Show("请选择导出数据的形式：是导出理论数据还是导出投标数据")

End If

dt = cmd.ExecuteReader()

For c As Integer = 0 To dt.DataCols.Count - 1

Sheet(0, c).Value = dt.DataCols(c).Name

‘填写数据代码，该代码没问题，但是屏蔽它，采用下面按折叠模式导出数据代码’

\' For r As Integer = 0 To dt.DataRows.Count - 1

\' For c As Integer = 0 To dt.DataCols.Count - 1

\' Sheet(r + 1, c).Value = dt.DataRows(r)(dt.DataCols(c).Name)

\' Next

\' 由于调用的后台数据表，采用临时表调取数据在设计这些表的时候本身就是采用折叠表的形式，想在导出表的时候，把折叠表全部展开，按折叠模式导出数据

Dim dtt As Table = Tables(" & nm & ")

\' Dim tns() As String = {"序号", "科目编码","项目构成", "单位", "用量" , "单价", "合价" , "备注"} \'要导出的列名，该代码取消，采用上面导出表的表结构代码（列名）

For r As Integer = 0 To dtt.Rows.Count - 1 \'填入数据

Dim rw As Row = dtt.Rows(r)

For c As Integer = 0 To dt.dataCols(c).Name.length - 1

If dtt.GridTreeVisible Then \'如果处于折叠模式

If dt.DataCols(c).Name(c) = "合价" Then

Sheet(r + 1, c).Value = rw.GetValue("合价")

ElseIf dt.DataCols(c).Name(c) = dtt Then

Sheet(r + 1, c).Value = New String(" ", rw.Hierarchy * 2) & rw(dtt)

Else

Sheet(r + 1, c).Value = rw(dt.dataCols(c).Name(c))

End If

Else

Sheet(r + 1, c).Value = rw(dt.dataCols(c).Name(c))

End If

\'打开工作簿

Book.Save(dlg.FileName)

Dim Proc As New Process

Proc.File = dlg.FileName

Proc.Start()

End If