-- 作者:湛江智
-- 发布时间:2018/5/20 19:22:00
-- [求助]导出单元格背景色和批注
导出单元格背景色和批注
批注和颜色记录信息,原来在要导出的表里面,调整到外面的表,背景批注表,这里的代码不会调整,求帮助 此主题相关图片如下:捕获.png
|
-- 作者:有点甜
-- 发布时间:2018/5/20 20:33:00
--
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
|