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

Dim dt As Table = Tables("设备设施清单")

Dim nms() As String = {"企业名称","编号","设备名称","类别","是否特种设备","数量","部门或车间","岗位或地点","责任人员","备注"} \'要导出的列名

Dim caps() As String = {"企业名称","编号","设备名称","类别","是否特种设备","数量","部门或车间","岗位或地点","责任人员","备注"} \'对应的列标题

Dim hlvl As Integer = 3

Dim szs() As Integer = {100,100,80} \'对应的列宽

Dim Book As New XLS.Book \'定义一个Excel工作簿

Dim Sheet As XLS.Sheet = Book.Sheets(0) \'引用工作簿的第一个工作表

Dim jz As xls.style = book.NewStyle

jz.AlignHorz = XLS.AlignHorzEnum.Center

jz.AlignVert = XLS.AlignVertEnum.Center

For c As Integer = 0 To nms.length -1

Dim ary() As String = caps(c).split("_")

For i As Integer = 0 To ary.length-1

sheet(i, c).value = ary(i)

sheet(i, c).Style = jz

For i As Integer = 0 To hlvl-1

Dim pi As Integer = 0

For c As Integer = 0 To nms.length -2

If sheet(i,c).text = sheet(i,c+1).text Then

Dim flag As Boolean = True

For k As Integer = i-1 To 0 Step -1

If sheet(k,c).value <> sheet(k,c+1).value Then

flag = False

End If

If flag Then

pi += 1

Else

pi = 0

End If

Else

sheet.MergeCell(i, c-pi, 1, pi+1)

pi = 0

End If

sheet.MergeCell(i, nms.length-pi-1, 1, pi+1)

For c As Integer = 0 To nms.length -1

Dim pi As Integer = 0

For i As Integer = hlvl-1 To 0 Step -1

If sheet(i, c).text = "" Then

pi += 1

Else

sheet.MergeCell(i, c, pi+1, 1)

Exit For

End If

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

For c As Integer = 0 To nms.length -1

Sheet(r+hlvl, c).Value = dt.rows(r)(nms(c))

Dim fl As String = ProjectPath & "Reports\\设备设施清单.xls"

Book.Build() \'生成细节区

Book.Save(fl) \'保存工作簿

Dim Proc As New Process \'打开工作簿

Proc.File = fl

Proc.Start()