本函数可实现以下功能:
1、根据指定表、指定列、指定表名生成excel文件;
2、如果目标文件名不存在,自动创建文件和sheet表;
3、如果目标文件已经打开,将给出提示;
4、如果目标文件存在同名表,可以选择追加,也可以选择覆盖。
函数名为ToList,调用方式为:
Functions.Execute("ToExcel",table,cols,sheetname,file,bl)其中,table为要导出的table表名,Table型
cols为要导出的列名,String型,如:A|B|C
Sheetname为导出到excel中的表名,String型
file为目标文件名
bl为
Boolean型,设为True时,自动覆盖同名表;否则将导出的数据添加在同名表后面。
函数ToList代码:
'5个入口参数:0来源表\1来源列\2目标表名\3目标文件\4是否覆盖
Dim t As Table = Args(0)
'定义工作簿
Dim Book As New XLS.Book
Dim Ss as String
If FileSys.FileExists(Args(3)) Then
Book = New XLS.Book(Args(3))
For i as Integer = 0 to Book.Sheets.Count - 1
Ss = Ss & "," & Book.Sheets(i).Name
Next
End If
Book.DefaultFont = New Font("宋体",9)
'定义显示风格
Dim Style As XLS.Style
Style = Book.NewStyle() '定义新样式
Style.BorderTop = XLS.LineStyleEnum.Thin
Style.BorderBottom = XLS.LineStyleEnum.Thin
Style.BorderLeft = XLS.LineStyleEnum.Thin
Style.BorderRight = XLS.LineStyleEnum.Thin
Style.BorderColorTop = Color.Black
Style.BorderColorBottom = Color.Black
Style.BorderColorLeft = Color.Black
Style.BorderColorRight = Color.Black
'定义工作表
Dim Sheet As XLS.Sheet
Dim qsh as Integer = 0 '默认起始行从0开始
If FileSys.FileExists(Args(3)) = False Then '如果文件不存在
Sheet = Book.Sheets(0)
Sheet.Name = Args(2)
Else
If Ss.Contains(Args(2)) = False Then '如果同名表不存在
Sheet = Book.Sheets.Add(Args(2))
Else
If Args(4) = False Then '如果不允许覆盖
Sheet = Book.Sheets(Args(2))
qsh = Sheet.Rows.Count + 1
Else '如果允许覆盖,先删除同名表再重建
Book.Sheets.Remove(Args(2))
Sheet = Book.Sheets.Add(Args(2))
End If
End If
End If
Sheet.ShowGridLines = False
'写入数据
Dim Cols as String() = Args(1).Split("|")
For c As Integer = 0 to Cols.Length - 1 '添加列标题
Sheet(qsh,c).Value = Cols(c)
Sheet(qsh,c).Style = Style
Next
For r As Integer = 0 to t.Rows.Count - 1 '填入数据
For c As Integer = 0 to Cols.Length - 1
Sheet(qsh + r + 1,c).Value = t.Rows(r)(c)
Sheet(qsh + r + 1,c).Style = Style '单元格样式
Next
Next
'判断目标文件的有效性
If FileSys.FileExists(Args(3)) Then
Try
Dim f As New System.IO.FileStream(Args(3),IO.FileMode.Open,IO.FileAccess.Read,IO.FileShare.None)
f.Dispose()
Book.Save(Args(3))
MessageBox.Show("数据已经成功导出! ","信息提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
Catch ex As Exception
MessageBox.Show("目标文件处于打开状态, 系统无法保存! 请将其关闭后重新导出本表数据! ","信息提示",MessageBoxButtons.OK,MessageBoxIcon.Warning)
End Try
Else
Book.Save(Args(3))
MessageBox.Show("数据已经成功导出! ","信息提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
End If