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
Next
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
Next
‘填写数据代码，该代码没问题，但是屏蔽它，采用下面按折叠模式导出数据代码’
' 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
' 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
Next
Next
'打开工作簿
Book.Save(dlg.FileName)
Dim Proc As New Process
Proc.File = dlg.FileName
Proc.Start()
Next
End If