以文本方式查看主题

-  Foxtable(狐表)  (http://www.foxtable.com/bbs/index.asp)
--  专家坐堂  (http://www.foxtable.com/bbs/list.asp?boardid=2)
----  关于导出Excel设定行高问题  (http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&id=147909)

--  作者:裴保民
--  发布时间:2020/3/26 22:50:00
--  关于导出Excel设定行高问题
Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open("d:\\test.xls")
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
Dim Rg As MSExcel.Range = Ws.Cells
Rg.WrapText = True 
\'Rg.EntireColumn.AutoFit   \'自动调整列宽
Rg.EntireRow.AutoFit  \'自动调整行高
App.Visible = True

这句话自动换行自动设置行高怎么不管用呢?

--  作者:有点蓝
--  发布时间:2020/3/27 10:11:00
--  
对合并单元格无效,如果有合并单元格,参考:http://www.foxtable.com/bbs/dispbbs.asp?BoardID=2&ID=134161&skin=0,看楼
--  作者:裴保民
--  发布时间:2020/3/27 10:43:00
--  
Dim i As Integer = 0
Dim dt As Table = Tables("按账户查账窗体_azhcxTable")
Dim dlg As New SaveFileDialog \'定义一个新的SaveFileDialog
Dim flg As New SaveExcelFlags
dlg.Filter= "Excel文件|*.xlsx" \'设置筛选器
dlg.FileName="按账户查账"
If dlg.ShowDialog = DialogResult.Ok Then \'如果用户单击了确定按钮
    Tables("按账户查账窗体_azhcxTable").SaveExcel(dlg.FileName, "按账户查账",flg.CellStyle=True )  \'保存文件
Else
    Return
End If
Dim Book As New XLS.Book(dlg.FileName)
Dim Sheet As XLS.Sheet = Book.Sheets(0) \'引用工作簿的第一个工作表
Dim Style As Xls.Style = Book.NewStyle \'新建一个样式
Dim Style02 As Xls.Style = Book.NewStyle \'新建一个样式
Dim Style1 As Xls.Style = Book.NewStyle \'新建一个样式
Dim Style12 As Xls.Style = Book.NewStyle \'新建一个样式
Dim Style2 As Xls.Style = Book.NewStyle \'新建一个样式
Dim Style3 As Xls.Style = Book.NewStyle \'新建一个样式
Dim Style4 As Xls.Style = Book.NewStyle \'新建一个样式
Dim Style5 As Xls.Style = Book.NewStyle \'新建一个样式
Style.ForeColor = Color.Red \'字体颜色设为红色
Style.Font =new font("宋体", 9,FontStyle.Bold ) \'\'字体为宋体12加粗
Style.Format =("0.00") \'格式化样式的字体颜色设为红色
Style.AlignHorz = XLS.AlignHorzEnum.Center
Style.WordWrap=True
Style02.ForeColor = Color.Red \'字体颜色设为红色
Style02.Font =new font("宋体", 9,FontStyle.Bold ) \'\'字体为宋体12加粗
Style02.Format =("0.00") \'格式化样式的字体颜色设为红色
Style02.BackColor =Color.Azure
Style02.AlignHorz = XLS.AlignHorzEnum.Center
Style02.WordWrap=True
Style1.ForeColor = Color.Blue  \'字体颜色设为蓝色
Style1.Font =new font("宋体", 9,FontStyle.Bold ) \'\'字体为宋体12加粗
Style1.Format =("0.00")\'\'格式化样式的字体颜色设为红色
Style1.AlignHorz = XLS.AlignHorzEnum.Center
Style1.WordWrap=True
Style12.ForeColor = Color.Blue  \'字体颜色设为蓝色
Style12.Font =new font("宋体", 9,FontStyle.Bold ) \'\'字体为宋体12加粗
Style12.Format =("0.00")\'\'格式化样式的字体颜色设为红色
Style12.BackColor =Color.Azure
Style12.AlignHorz = XLS.AlignHorzEnum.Center
Style12.WordWrap=True
Style2.ForeColor = Color.Red \'字体颜色设为蓝色
Style2.Font =new font("宋体", 9,FontStyle.Bold ) \'\'字体为宋体12加粗
Style2.Format =("0.00")\'\'格式化样式的字体颜色设为红色
Style2.BackColor =Color.PaleGreen   \'格式背景颜色设为红色
Style2.AlignHorz = XLS.AlignHorzEnum.Center
Style2.WordWrap=True
Style3.BackColor =Color.PaleGreen   \'格式背景颜色设为红色
Style3.Font =new font("宋体", 10,FontStyle.Bold ) \'\'字体为宋体12加粗
Style3.BackColor =Color.LightGray \'格式背景颜色设为红色
Style3.AlignHorz = XLS.AlignHorzEnum.Center
Style3.WordWrap=True
Style4.BackColor =Color.Azure \'格式背景颜色设为红色
Style4.AlignHorz = XLS.AlignHorzEnum.Center
Style4.WordWrap=True
Style5.BackColor =Color.Azure \'格式背景颜色设为红色
Style5.Format =("yyyy-MM-dd")\'\'
Style5.AlignHorz = XLS.AlignHorzEnum.Center
Style5.WordWrap=True
For Each c As Col In dt.Cols
    If c.visible Then i+=1
Next
For r As Integer = 0 To dt.Rows.Count \'填入数据
    If  r Mod 2 =0 Then \'如果是偶数行
        For lzs As Integer = 0 To i-1  \'dt.Cols.Count-5  \'填入数据
            Sheet( r+1 ,lzs ).Style =Style4 \'设置单元格样式
        Next
        Sheet(r + 1,dt.Cols("支出金额").Index).Style = Style02 \'设置折扣单元格的样式
        Sheet(r + 1,dt.Cols("收入金额").Index).Style = Style12 \'设置折扣单元格的样式
        Sheet(r + 1,dt.Cols("记账日期").Index).Style = Style5 \'设置折扣单元格的样式
    Else
        Sheet(r + 1,dt.Cols("支出金额").Index).Style = Style \'设置折扣单元格的样式
        Sheet(r + 1,dt.Cols("收入金额").Index).Style = Style1 \'设置折扣单元格的样式
    End If
Next
Sheet(dt.Rows.Count+1,0).value = "记录数 [" & dt.Rows.Count & "]"
Sheet(dt.Rows.Count+1,dt.Cols("支出金额").Index).value = dt.compute("sum(支出金额)")
Sheet(dt.Rows.Count+1,dt.Cols("收入金额").Index).value = dt.compute("sum(收入金额)")
For cc As Integer = 0 To i-1 \'填入数据
    Sheet(dt.Rows.Count+1,cc).Style = Style2
    Sheet(0,cc).Style = Style3
Next
\'
\'\'Dim Book As New XLS.Book(dlg.FileName)
\'Dim fl As String = dlg.FileName
\'Dim App As New MSExcel.Application
\'Book.Build() \'生成细节区
\'Book.Save(fl) \'保存工作簿
\'Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(fl)                     (1)自动调整行高的代码应该放到什么位置呢?放到这里提示文件已打开
\'Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
\'Dim Rg As MSExcel.Range = Ws.Cells
\'Rg.EntireRow.AutoFit  \'自动调整行高
\'App.Visible = True
Book.Save(ProjectPath & "按账户查账_" & Format(Date.Now,"yyyyMMdd HHmmss") & ".xls" )
Dim Proc As New Process
Proc.File =ProjectPath & "按账户查账_" & Format(Date.Now,"yyyyMMdd HHmmss") & ".xls"
Proc.Start()

If FileSys.FileExists("dlg.FileName") Then \'如果指定的文件存在
    FileSys.DeleteFile("dlg.FileName",2,2) \'则彻底删除之                                  (2)还有这段代码运行后不起作用删除不了刚建的文件
End If

[此贴子已经被作者于2020/3/27 10:45:35编辑过]

--  作者:有点蓝
--  发布时间:2020/3/27 12:03:00
--  
For cc As Integer = 0 To i-1 \'填入数据
    Sheet(dt.Rows.Count+1,cc).Style = Style2
    Sheet(0,cc).Style = Style3
Next
Dim fl As String = ProjectPath & "按账户查账_" & Format(Date.Now,"yyyyMMdd HHmmss") & ".xls"
Book.Save(fl)

If FileSys.FileExists(dlg.FileName) Then \'如果指定的文件存在
    FileSys.DeleteFile(dlg.FileName,2,2) \'则彻底删除之                                  (2)还有这段代码运行后不起作用删除不了刚建的文件
End If

Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(fl)                     (1)自动调整行高的代码应该放到什么位置呢?放到这里提示文件已打开
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
Dim Rg As MSExcel.Range = Ws.Cells
Rg.EntireRow.AutoFit  \'自动调整行高
Wb.save
App.Visible = True


--  作者:裴保民
--  发布时间:2020/3/27 12:21:00
--  
打开excel文件后怎么不上所有行的调整呢?是隔一行调整一行

图片点击可在新窗口打开查看此主题相关图片如下:截图09.jpg
图片点击可在新窗口打开查看


--  作者:有点蓝
--  发布时间:2020/3/27 13:38:00
--  
Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(fl)                     (1)自动调整行高的代码应该放到什么位置呢?放到这里提示文件已打开
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
Dim Rg As MSExcel.Range = Ws.Cells
rg.WrapText = true
Rg.EntireRow.AutoFit  \'自动调整行高
Wb.save
App.Visible = True

--  作者:裴保民
--  发布时间:2020/3/27 14:09:00
--  
如果直接答应窗体表中的带有各式的数据怎么设置呢?

图片点击可在新窗口打开查看此主题相关图片如下:截图10.jpg
图片点击可在新窗口打开查看


--  作者:有点蓝
--  发布时间:2020/3/27 14:17:00
--  
drawcell设置的样式才可以导出
--  作者:裴保民
--  发布时间:2020/3/27 14:29:00
--  

图片点击可在新窗口打开查看此主题相关图片如下:截图11.jpg
图片点击可在新窗口打开查看

图片点击可在新窗口打开查看此主题相关图片如下:截图12.jpg
图片点击可在新窗口打开查看

数据结果和样式对不对,怎么设置呢?

[此贴子已经被作者于2020/3/27 14:30:09编辑过]

--  作者:有点蓝
--  发布时间:2020/3/27 14:33:00
--  
合计行是使用非正常方式设置的,无法导出。只能使用3楼的方法处理