Dim t As Table = Tables("导出这个表单元格颜色和批注")
Dim file As String = "d:\test123.xls"
Dim flg As New SaveExcelFlags
flg.CellStyle = True
t.SaveExcel(file,t.name,flg)
Dim App As New MSExcel.Application
Dim Wb As MSExcel.Workbook = App.WorkBooks.Open(file)
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
Dim Rg As MSExcel.Range = Ws.UsedRange
For Each c As Col In t.Cols
If c.IsBoolean Then
For i As Integer = t.HeaderRows+1 To rg.Rows.count
If ws.cells(i, c.Index+1).value = "false" Then
ws.cells(i, c.Index+1).value = ""
Else
ws.cells(i, c.Index+1).value = "√"
End If
Next
End If
Next
rg.ClearComments '清除原有批注
For Each r As Row In t.Rows '批注和颜色记录信息,原来在要导出的表里面,调整到外面的表,背景批注表,这里的代码不会调整,求帮助
Dim dr As DataRow = DataTables("背景批注").Find("表名 = '" & r.Table.name & "' and 行号 = '" & r("_Identify") & "'")
If dr IsNot Nothing
Dim Beizhu As String = dr("批注") '批注和颜色记录信息,原来在要导出的表里面,调整到外面的表,背景批注表,这里的代码不会调整,求帮助
If beizhu > "" Then
Dim BZs() As String
BZs = Beizhu.split("|")
For Index As Integer = 0 To BZs.Length - 1
Dim BZInfo() As String
BZInfo = BZs(Index).split(",")
Ws.cells(r.index+t.HeaderRows+1, t.Cols(bzinfo(0)).Index+1).AddComment(bzinfo(1)) 'B2单元格添加批注,注意批注内容在园括号内Next
Next
End If
Dim bj As String = dr("背景") '批注和颜色记录信息,原来在要导出的表里面,调整到外面的表,背景批注表,这里的代码不会调整,求帮助
If bj > "" Then
Dim BZs() As String
BZs = bj.split("|")
For Index As Integer = 0 To BZs.Length - 1
Dim BZInfo() As String
BZInfo = BZs(Index).split(",")
Dim clr As Color = Color.FromARGB(bzinfo(1))
Ws.cells(r.index+t.HeaderRows+1, t.Cols(bzinfo(0)).Index+1).Interior.Color = RGB(clr.r, clr.g, clr.b)
Next
End If
End If
Next
app.visible = True