Foxtable(狐表) → 用户栏目 → 专家坐堂 → excel报表 怎么在生成复杂表头的前提上新增一行作标题 在新增一行 加单位 呢？


  共有4797人关注过本帖树形打印复制链接

主题：excel报表 怎么在生成复杂表头的前提上新增一行作标题 在新增一行 加单位 呢？
帅哥哟，离线，有人找我吗？
有点蓝
 小大  11楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：107873 积分：548728 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2021/5/18 8:31:00 [显示全部帖子]

Dim tbl As Table = Tables("党史统计表")
Dim dt1 As Table = Tables("词典")

Dim hdr As Integer = tbl.HeaderRows '获得表头的层数
Dim cnt As Integer
Dim Book As New XLS.Book
Dim Style As Xls.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
Style.AlignHorz=XLS.AlignHorzEnum.Center
Style.AlignVert=XLS.AlignVertEnum.Center
Style.FontBold = True '字体加粗
Style.Font = New Font("仿宋", 11 , FontStyle.Bold)
Style.WordWrap=True

Dim St21 As Xls.Style = Book.NewStyle '新建一个时间格式化样式
st21.Font = New Font("仿宋", 20 , FontStyle.Bold)
St21.AlignHorz=XLS.AlignHorzEnum.Center
St21.AlignVert=XLS.AlignVertEnum.Center

Dim St211 As Xls.Style = Book.NewStyle '新建一个时间格式化样式
st211.Font = New Font("仿宋", 11 , FontStyle.Bold)
St211.AlignHorz=XLS.AlignHorzEnum.Left
St211.AlignVert=XLS.AlignVertEnum.Center
Dim St2111 As Xls.Style = Book.NewStyle '新建一个时间格式化样式
st2111.Font = New Font("仿宋", 30 , FontStyle.Bold)
St2111.AlignHorz=XLS.AlignHorzEnum.Center
St2111.AlignVert=XLS.AlignVertEnum.Center

Dim Sheet As XLS.Sheet = Book.Sheets(0)
sheet.Name="学习教育工作情况统计表"
tbl.CreateSheetHeader(Sheet) '生成表头
Sheet.Rows.Insert(0)
Sheet.Rows.Insert(0)
Sheet(0, 0).Value ="党史学习教育暨" & """牢记殷切嘱托 忠诚干净担当 喜迎建党百年""" & "专题教育工作开展情况统计表"
Sheet(0, 0).Style=st2111
Sheet.MergeCell(0,0,1,32)
Sheet(1, 0).Value ="单位:"
Sheet(1, 0).Style=st211
Sheet.MergeCell(1,1,1,3)
Sheet(1, 1).Value ="工信局"
Sheet(1, 1).Style=st211
Sheet.MergeCell(1,1,1,5)
Sheet(1, 6).Value ="填报人:"
Sheet.MergeCell(1,6,1,2)
Sheet(1, 6).Style=st211
Sheet(1, 8).Value ="张三"
Sheet(1, 8).Style=st211
Sheet.MergeCell(1,8,1,3)
Sheet(1, 11).Value ="联系电话:"
Sheet.MergeCell(1,11,1,2)
Sheet(1, 11).Style=st211
Sheet(1, 13).Value ="1388888888"
Sheet(1, 13).Style=st211
Sheet(1, 19).Value ="报表时间:"
Sheet(1, 19).Style=st211
Sheet(1, 20).Value =Format(Date.today, "yyyy年MM月dd日")

Sheet(1, 20).Style=st211
Sheet(1, 22).Value ="主要领导签字:"
Sheet(1, 22).Style=st211
Sheet.MergeCell(1,22,1,4)

Dim St2 As Xls.Style = Book.NewStyle '新建一个时间格式化样式
St2.Format = "yyyy-MM-dd"
St2.BorderTop = XLS.LineStyleEnum.Thin
St2.BorderBottom = XLS.LineStyleEnum.Thin
St2.BorderLeft = XLS.LineStyleEnum.Thin
St2.BorderRight = XLS.LineStyleEnum.Thin
St2.BorderColorTop = Color.Black
St2.BorderColorBottom = Color.Black
St2.BorderColorLeft = Color.Black
St2.BorderColorRight = Color.Black
St2.AlignHorz=XLS.AlignHorzEnum.Center
St2.AlignVert=XLS.AlignVertEnum.Center
St2.FontBold = True '字体加粗
St2.Font = New Font("仿宋", 12, FontStyle.Bold)
st2.WordWrap=True

For c As Integer = 0 To tbl.Cols.Count - 1
    Sheet.Cols(c).Width =40
Next
Sheet.Cols(13).Width =150
Sheet.Cols(14).Width =90
Sheet.Cols(16).Width =120
Sheet.Cols(17).Width =150
Sheet.Cols(19).Width =120
Sheet.Cols(20).Width =150
Sheet.Cols(22).Width =150
Sheet.Cols(23).Width =90
Sheet.Cols(24).Width =80
Sheet.Cols(26).Width =120
Sheet.Cols(30).Width =120
Sheet.Rows(0).Height = 80
Sheet.Rows(1).Height = 40
Sheet.Rows(2).Height = 40
Sheet.Rows(3).Height = 80
Sheet.Rows.Frozen = 4  '冻结表前面四行

Dim r22 As Integer = 4
Dim r11 As Integer = 0
For r11 = 0 To dt1.Rows.Count - 1 '填入数据
    Sheet.Rows(r22).Height = 50
    For c11 As Integer = 0 To tbl.Cols.Count-1
        Sheet(r22, 13).Value = dt1.rows(r11)(0)
        Sheet(r22, 12).Value = r11+1
        If tbl.Cols(c11).IsDate
            Sheet(r22,c11).Style = St2
        Else
            Sheet(r22,c11).Style = Style
        End If
    Next
    If r11 Mod 5 = 4 Then '每页5行后强制换页
        '添加页尾
        Sheet(r22+1,0).Value="测试"
        Sheet.MergeCell(25,0,1,32)
        Sheet(r22+2,0).Value="测试"
        Sheet.MergeCell(26,0,1,32)
        Sheet(r22+3,0).Value="测试"
        Sheet.MergeCell(27,0,1,32)
        '换页
        Sheet.Rows(r22+3).PageBreak = True   
        r22 += 4
    Else
        r22 += 1
    End If
Next
'处理空行
Dim a As Integer = 5 - r11 Mod 5 '计算剩余空行
For ii As Integer = 1 To a
    Sheet.Rows(r22).Height = 50
    For c11 As Integer = 0 To tbl.Cols.Count-1
        If tbl.Cols(c11).IsDate
            Sheet(r22,c11).Style = St2
        Else
            Sheet(r22,c11).Style = Style
        End If
    Next
    r22 += 1
Next
Sheet(r22,0).Value="测试"
Sheet.MergeCell(25,0,1,32)
Sheet(r22+1,0).Value="测试"
Sheet.MergeCell(26,0,1,32)
Sheet(r22+2,0).Value="测试"
Sheet.MergeCell(27,0,1,32)
 回到顶部
帅哥哟，离线，有人找我吗？
有点蓝
 小大  12楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：107873 积分：548728 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2021/5/18 8:32:00 [显示全部帖子]

With Sheet.PrintSetting
    .AutoScale = True
    .FitPagesAcross=1
    .PaperKind = 8 '设为A3纸
    .LandScape = True '横向打印
    .MarginLeft = 20 '左右边距设为20毫米
    .MarginRight = 20
    .MarginTop = 15 '上下边距设为15毫米
    .MarginBottom = 15
    .Footer = "&R第&P页,总&N页"
End With

Book.Save("D:\问题\test.xls")
'Dim Proc As New Process
'Proc.File = "c:\reports\test.xls"
'Proc.Start()

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.Range("A10")
With Ws.PageSetup
    '设置打印区域
    .PaperSize = MSExcel.XlPaperSize.xlPaperA3   '纸张大小
    .PrintTitleRows = Ws.Range("1:4").Address '打印行标题(在每一页的顶部重复出现)
    .Orientation = MSExcel.xlPageOrientation.xlLandscape '横向打印
End With

App.Visible = True
Ws.PrintPreview
'App.Quit
 回到顶部
帅哥哟，离线，有人找我吗？
有点蓝
 小大  13楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：107873 积分：548728 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2021/5/18 9:28:00 [显示全部帖子]

这种问题先做测试，测试结果有问题再提。
[此贴子已经被作者于2021/5/18 9:28:25编辑过]
 回到顶部
帅哥哟，离线，有人找我吗？
有点蓝
 小大  14楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：107873 积分：548728 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2021/5/18 10:15:00 [显示全部帖子]

Dim r22 As Integer = 4
Dim r11 As Integer = 0
For r11 = 0 To dt1.Rows.Count - 1 '填入数据
……
    If r11 Mod 20 = 19 Then '每页5行后强制换页
        '添加页尾
……
        '换页
        Sheet.Rows(r22+3).PageBreak = True
        r22 += 4
    Else
        r22 += 1
    End If
Next
'处理空行
Dim a As Integer = 20 - r11 Mod 20 '计算剩余空行
For ii As Integer = 1 To a
……
    r22 += 1
Next
 回到顶部
帅哥哟，离线，有人找我吗？
有点蓝
 小大  15楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：107873 积分：548728 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2021/5/18 12:03:00 [显示全部帖子]

请自行跟踪调试

 回到顶部
帅哥哟，离线，有人找我吗？
有点蓝
 小大  16楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：107873 积分：548728 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2021/5/18 13:40:00 [显示全部帖子]

        Sheet.Rows(r22+5).PageBreak = True
        r22 += 6
    Else
        r22 += 1
    End If
 回到顶部
总数 17 上一页 1 2
RSS2.0 | Xhtml无图版 | Xslt无图版 Copyright © 2000 - 2018 foxtable.com Tel: 4000-810-820 粤ICP备11091905号
   Powered By Dvbbs Version 8.3.0
页面执行时间 0.06055 秒, 5 次数据查询