- Foxtable(狐表) (http://foxtable.net/bbs/index.asp)
-- 专家坐堂 (http://foxtable.net/bbs/list.asp?boardid=2)
---- 导出表格时，如下代码中怎么设置自动列宽，表格线变成实线，然后第一次导出保存文件名为表A，导出时依次保存不覆盖文件? (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=191925)
-- 发布时间：2024/5/16 9:25:00
-- 导出表格时，如下代码中怎么设置自动列宽，表格线变成实线，然后第一次导出保存文件名为表A，导出时依次保存不覆盖文件?
导出表格时，如下代码中怎么设置自动列宽，表格线变成实线，然后第一次导出保存文件名为表A，下一次导出时保存文件名为表A1,表A2,表A3，依次保存不覆盖文件?
Dim tbl As Table = Tables("表A")
Dim Book As New XLS.Book
Dim Sheet As XLS.Sheet = Book.Sheets(0)
Dim St2 As XLS.Style = Book.NewStyle
St2.Format = "yyyy-MM-dd"
Sheet.Cols(tbl.Cols("出生日期").Index).Style = st2
Dim hdr As Integer = tbl.HeaderRows \'获得表头的层数
tbl.CreateSheetHeader(Sheet) \'生成表头
Dim cnt As Integer
For c As Integer = 0 To tbl.Cols.Count - 1
If tbl.Cols(c).Visible Then
For r As Integer = 0 To tbl.Rows.Count - 1
sheet(r + hdr, cnt).value = tbl(r, c)
Next
cnt = cnt + 1
End If
Next
Book.Save("D:\\reports\\表A.xls")
Dim Proc As New Process \'定义一个新的Process
Proc.File = "d:\\Reports" \'指定文件夹路径
Proc.Start()
-- 发布时间：2024/5/16 9:48:00
--
1、表格线：http://www.foxtable.com/webhelp/topics/1163.htm
2、重命名的话，建一个内部表只有一行一列，单元格填入序号比如1，那么第一次文件名为A1，就把单元格值+1，大概
……
dim a as integer = tables("某表").rows(0)(0)
Book.Save("D:\\reports\\A" & a & ".xls")
tables("某表").rows(0)(0) = a+1
Dim Proc As New Process \'定义一个新的Process
3、自动列宽就需要另外处理了，先生成报表，然后另外使用vba控制：http://www.foxtable.com/webhelp/topics/2121.htm
Rg.EntireColumn.AutoFit \'自动调整列宽
-- 发布时间：2024/5/16 11:43:00
--
如我要设置单元格字号放在哪？代码怎么写下？
-- 发布时间：2024/5/16 11:56:00
--
比如
Dim Style As XLS.Style = Book.NewStyle() \'定义新样式
Style.ForeColor = Color.Red \'设置样式的字体颜色
Style.ForeColor = Color.Red \'设置样式的字体颜色
Style.font = New Font("宋体",10)
-- 发布时间：2024/5/16 12:34:00
--
如下代码，所有单元格也都加了实线，字号也设置为10磅，想把表标题行设置为12磅，单元格还是10磅，导出有数据的行、列加边框线，其他地方不加线，怎么改下？
Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open("D:\\表A.xls")
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
Dim Rg As MSExcel.Range = Ws.Cells
Rg.EntireColumn.AutoFit \'自动调整列宽
Rg.EntireRow.AutoFit \'自动调整行高
Rg.Font.Size = 10
Rg.Borders.Linestyle = MSExcel.XlLineStyle.xlContinuous \'边框线型
Rg.Borders.Weight = MSExcel.XlBorderWeight.xlThin\'边框粗细
App.Visible = True
-- 发布时间：2024/5/16 13:30:00
--
Dim Rg As MSExcel.Range = Ws.UsedRange
-- 发布时间：2024/5/16 17:02:00
--
上面的代码完美实现了，但是发现有的表导出来的时候后面增加了好多空列，这是怎么回事？如果删除空列怎么写？
-- 发布时间：2024/5/16 17:31:00
--
完整代码？
-- 发布时间：2024/5/16 17:41:00
--
Dim tbl As Table = Tables("表A")
Dim Book As New XLS.Book
Dim Sheet As XLS.Sheet = Book.Sheets(0)
Dim St1 As XLS.Style = Book.NewStyle
St1.Format = "yyyy-MM-dd"
Sheet.Cols(tbl.Cols("出生日期").Index).Style = st1
Dim hdr As Integer = tbl.HeaderRows \'获得表头的层数
tbl.CreateSheetHeader(Sheet) \'生成表头
Dim cnt As Integer
For c As Integer = 0 To tbl.Cols.Count - 1
If tbl.Cols(c).Visible Then
For r As Integer = 0 To tbl.Rows.Count - 1
sheet(r + hdr, cnt).value = tbl(r, c)
Next
cnt = cnt + 1
End If
Next
Book.Save("D:\\reports\\表A.xls")
Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open("D:\\reports\\表A.xls")
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
Dim Rg As MSExcel.Range = Ws.UsedRange
Rg.EntireColumn.AutoFit \'自动调整列宽
Rg.EntireRow.AutoFit \'自动调整行高
Rg.Font.Size = 11
Rg.Borders.Linestyle = MSExcel.XlLineStyle.xlContinuous \'边框线型
Rg.Borders.Weight = MSExcel.XlBorderWeight.xlThin\'边框粗细
App.Visible = True
Dim Proc As New Process \'定义一个新的Process
Proc.File = "D:\\Reports" \'指定文件夹路径
Proc.Start()
-- 发布时间：2024/5/16 17:44:00
--
Dim tbl As Table = Tables("表A")
Dim Book As New XLS.Book
Dim Sheet As XLS.Sheet = Book.Sheets(0)
Dim St1 As XLS.Style = Book.NewStyle
St1.Format = "yyyy-MM-dd"
Dim hdr As Integer = tbl.HeaderRows \'获得表头的层数
tbl.CreateSheetHeader(Sheet) \'生成表头
Dim cnt As Integer
For c As Integer = 0 To tbl.Cols.Count - 1
If tbl.Cols(c).Visible Then
if tbl.Cols(c).IsDate
Sheet.Cols(cnt).Style = st1
next
For r As Integer = 0 To tbl.Rows.Count - 1
sheet(r + hdr, cnt).value = tbl(r, c)
Next
cnt = cnt + 1
End If
Next
Book.Save("D:\\reports\\表A.xls")