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


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

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


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		回复：（有点蓝）升级到最新版  发帖心情 Post By：2021/5/17 22:55:00 [只看该作者]

加密狗到期了  已经无法升级到最新版了   所以要麻烦老师了

 回到顶部
帅哥，在线噢！
有点蓝
 小大  22楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：107837 积分：548536 威望：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)
 回到顶部
帅哥，在线噢！
有点蓝
 小大  23楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：107837 积分：548536 威望：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
 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  24楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		回复：（有点蓝）With Sheet.PrintSetting  &nbs...  发帖心情 Post By：2021/5/18 9:15:00 [只看该作者]

谢谢老师！
参照老师的代码写法，运行后列标题行没有画上线框。
我加上：
For r33 As Integer = 2 To 3 Step 1
    For c33 As Integer = 0 To tbl.Cols.Count-1
        If tbl.Cols(c33).IsDate
            Sheet(r33,c33).Style = St2
        Else
            Sheet(r33,c33).Style = Style
        End If
    Next    
Next
问题得以完美解决。谢谢老师的耐心指导！
 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  25楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		回复：（有点蓝）With Sheet.PrintSetting  &nbs...  发帖心情 Post By：2021/5/18 9:25:00 [只看该作者]

如果我想要修改每隔20行之后强制换页  下述代码我该怎么修改完善呢？
Dim r22 As Integer = 4
Dim r11 As Integer = 0
For r11 = 0 To dt1.Rows.Count - 1 '填入数据
……
    If r11 Mod 5 = 4 Then '每页5行后强制换页
        '添加页尾
……
        '换页
        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
……
    r22 += 1
Next

直接把上面的5改成20么？
 回到顶部
帅哥，在线噢！
有点蓝
 小大  26楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：107837 积分：548536 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2021/5/18 9:28:00 [只看该作者]

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


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		回复：（有点蓝）这种问题先做测试，测试结果有问题再...  发帖心情 Post By：2021/5/18 10:10:00 [只看该作者]

经过测试：当想设定20行再强制换页的时候，下述代码没有实现对应的行数值确定   只有一页满足了20行换页并显示了页尾内容

麻烦老师指导下 看看我标注的红色部分理解是否正确   如果不正确麻烦老师指导下   我该怎么正确理解   谢谢！

（词典表有数据42行，）
Dim r22 As Integer = 4    我理解为该数字为标题和列标题的所占的行数
Dim r11 As Integer = 0    我理解为定义数据填入的行数，当前词典表有42行数据 那接下来的遍历就是从0到42行
For r11 = 0 To dt1.Rows.Count - 1 '填入数据                从0到42行逐一减1
    Sheet.Rows(r22).Height = 50
    For c11 As Integer = 0 To tbl.Cols.Count-1          遍历tb1的所有列数
        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 20 = 4 Then '每页x行后强制换页       r11 mod 20 不一定都大于1   这个地方就会导致页尾部分不能每页都显示了
        '添加页尾
        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 = 20 - r11 Mod 4 '计算剩余空行    这个计算空行也出现一样的问题  r11 mod 4 有时候不一定是>1
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 
 回到顶部
帅哥，在线噢！
有点蓝
 小大  28楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：107837 积分：548536 威望：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
 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  29楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		回复：（有点蓝）Dim r22 As Integer = 4Dim r11 As I...  发帖心情 Post By：2021/5/18 12:01:00 [只看该作者]

换页正常了 
但是数据显示缺少了一行   还得继续麻烦老师了  

图片点击可在新窗口打开查看此主题相关图片如下：12.png
图片点击可在新窗口打开查看
 回到顶部
帅哥，在线噢！
有点蓝
 小大  30楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：107837 积分：548536 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2021/5/18 12:03:00 [只看该作者]

请自行跟踪调试

 回到顶部
总数 34 上一页 1 2 3 4 下一页
RSS2.0 | Xhtml无图版 | Xslt无图版 Copyright © 2000 - 2018 foxtable.com Tel: 4000-810-820 粤ICP备11091905号
   Powered By Dvbbs Version 8.3.0
页面执行时间 0.05078 秒, 4 次数据查询