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
Next
Next
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
Next
If flag Then
pi += 1
Else
pi = 0
End If
Else
sheet.MergeCell(i, c-pi, 1, pi+1)
pi = 0
End If
Next
sheet.MergeCell(i, nms.length-pi-1, 1, pi+1)
Next
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
Next
Next
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))
Next
Next
Dim fl As String = ProjectPath & "Reports\设备设施清单.xls"
Book.Build() '生成细节区
Book.Save(fl) '保存工作簿
Dim Proc As New Process '打开工作簿
Proc.File = fl
Proc.Start()
加好友 
发短信
Post By：2019/8/28 21:05:00 [只看该作者]
