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


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

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


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		excel报表 怎么在生成复杂表头的前提上新增一行作标题 在新增一行 加单位 呢？  发帖心情 Post By：2021/5/15 16:16:00 [显示全部帖子]

excel报表  怎么在生成复杂表头的前提上新增一行作标题 在新增一行 加单位 呢？
下述红色代码没有发挥作用   麻烦老师们指导下！谢谢！

当前代码如下：
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 Sheet As XLS.Sheet = Book.Sheets(0)
tbl.CreateSheetHeader(Sheet) '生成表头

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("仿宋", 12 , 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 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 =80
    Sheet.Cols(13).Width =400
    Sheet.Cols(16).Width =200
    Sheet.Cols(17).Width =400
    Sheet.Cols(19).Width =200
    Sheet.Cols(20).Width =400
    Sheet.Cols(22).Width =400
    Sheet.Cols(26).Width =400
    Sheet.Cols(30).Width =200
    'Sheet(0, c).Value ="党史学习教育开展情况统计表"   
    'Sheet.MergeCell(0,0,1,c+1)
    'Sheet(1, 0).Value ="单位"    
    'Sheet.MergeCell(1,2,1,3)
    If tbl.Cols(c).Visible Then
        For r As Integer = 0 To tbl.Rows.Count - 1
            Sheet.Rows(0).Height = 40
            Sheet.Rows(1).Height = 40
            Sheet.Rows(r).Height = 30
            sheet(r + hdr+2,cnt).value = tbl(r,c)
        Next
        cnt = cnt + 1
    End If
Next
For r1 As Integer = 0 To dt1.Rows.Count - 1 '填入数据
    For c1 As Integer = 0 To tbl.Cols.Count-1
        Sheet(r1+2, 13).Value = dt1.rows(r1)(0)    
        Sheet(r1+2, 12).Value = r1+1  
    Next
Next
For r2 As Integer = 0 To Sheet.rows.count-1
Sheet.Rows(0).Height = 40
Sheet.Rows(1).Height = 60
Sheet.Rows(r2).Height = 30
'Sheet(0, 1).style=st21
    For c1 As Integer = 0 To tbl.Cols.Count-1
        If tbl.Cols(c1).IsDate
            Sheet(r2,c1).Style = St2
        Else
            Sheet(r2,c1).Style = Style
        End If
    Next
Next
Book.Save("c:\reports\test.xls")
Dim Proc As New Process
Proc.File = "c:\reports\test.xls"
Proc.Start()
实现效果如下：

图片点击可在新窗口打开查看此主题相关图片如下：1.png
图片点击可在新窗口打开查看

[此贴子已经被作者于2021/5/15 16:19:47编辑过]
 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		回复：（有点蓝）红色代码放到for循环外面  &nbs...  发帖心情 Post By：2021/5/15 17:11:00 [显示全部帖子]

代码如下：红色部分代码用其中一个  效果都是一样的   没有成功显示表头     麻烦老师指导下  谢谢！
Dim tbl As Table = Tables("党史统计表") 
Dim dt1 As Table = Tables("词典")
Dim hdr As Integer = tbl.HeaderRows '获得表头的层数
Dim Book As New XLS.Book
Dim Sheet As XLS.Sheet = Book.Sheets(0)

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("仿宋", 12 , 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 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
Sheet(0, 0).Value ="党史学习教育开展情况统计表"
Sheet.MergeCell(0,0,1,32)
Sheet(1, 0).Value ="单位"
Sheet.MergeCell(1,2,1,3)
For c As Integer = 0 To tbl.Cols.Count - 1
    Sheet.Cols(c).Width =80
    Sheet.Cols(13).Width =400
    Sheet.Cols(16).Width =200
    Sheet.Cols(17).Width =400
    Sheet.Cols(19).Width =200
    Sheet.Cols(20).Width =400
    Sheet.Cols(22).Width =400
    Sheet.Cols(26).Width =400
    Sheet.Cols(30).Width =200
    Dim cnt As Integer = Sheet.rows.count
    If tbl.Cols(c).Visible Then
        For r As Integer = 0 To tbl.Rows.Count - 1
            output.Show(r)
            Sheet.Rows(0).Height = 40
            Sheet.Rows(1).Height = 40
            Sheet.Rows(2).Height = 40
            Sheet.Rows(3).Height = 40
            Sheet.Rows(r).Height = 30
            sheet(r + hdr+2,cnt).value = tbl(r,c)
            'sheet(r + 4,cnt).value = tbl(r,c)
        Next
        cnt = cnt + 1
    End If
Next

For r1 As Integer = 0 To dt1.Rows.Count - 1 '填入数据
    For c1 As Integer = 0 To tbl.Cols.Count-1
        Sheet(r1+4, 13).Value = dt1.rows(r1)(0)
        Sheet(r1+4, 12).Value = r1+1
    Next
Next
For r2 As Integer = 0 To Sheet.rows.count-1
    Sheet.Rows(0).Height = 40
    Sheet.Rows(1).Height = 60
    Sheet.Rows(r2).Height = 30
    'Sheet(0, 1).style=st21
    For c1 As Integer = 0 To tbl.Cols.Count-1
        If tbl.Cols(c1).IsDate
            Sheet(r2,c1).Style = St2
        Else
            Sheet(r2,c1).Style = Style
        End If
    Next
Next
Book.Save("c:\reports\test.xls")
Dim Proc As New Process
Proc.File = "c:\reports\test.xls"
Proc.Start()

运行效果如图：

图片点击可在新窗口打开查看此主题相关图片如下：1.png
图片点击可在新窗口打开查看
 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		回复：（有点蓝）当前代码如下:Dim tbl As Table = Ta...  发帖心情 Post By：2021/5/15 19:31:00 [显示全部帖子]

词典表只有十八条数据  下述代码运行之后会新增18+5行数据 

 麻烦老师看看  
1、5行是空白不应出现的  ，不晓得是哪个位置出错了。
2、怎么实现控制表除了四行表标题外   接下来只能填入20行数据 （如果只有18行数据  补足20行） 
然后满足24行后  就强制换页
3、在第24行后面新增一行  作为备注栏  并且备注栏也和表标题对应  显示在第二页及第N页   
怎么写代码固定表标题及备注栏在N页后都显示呢？


红色部分代码为时：
        If tbl.Cols(c1).IsDate
            Sheet(r2,c1).Style = St2
        Else
            Sheet(r2,c1).Style = Style
        End If

运行效果：

图片点击可在新窗口打开查看此主题相关图片如下：1.png
图片点击可在新窗口打开查看

红色部分代码为时：
        If tbl.Cols(c1).IsDate
            Sheet(r2+2,c1).Style = St2
        Else
            Sheet(r2+2,c1).Style = Style
        End If

运行效果：

图片点击可在新窗口打开查看此主题相关图片如下：2.png
图片点击可在新窗口打开查看


当前代码：
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 ="xxxx"
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 ="xxxx"
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 ="xxxxx"
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)

Sheet.Rows(24).PageBreak = True   '每页24行后强制换页
Sheet.Rows.Frozen = 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


For r11 As Integer = 0 To dt1.Rows.Count - 1 '填入数据
    For c11 As Integer = 0 To tbl.Cols.Count-1
        Sheet(r11+4, 13).Value = dt1.rows(r11)(0)
        Sheet(r11+4, 12).Value = r11+1
    Next
Next
For r2 As Integer = 0 To Sheet.rows.count-1
    Sheet.Rows(0).Height = 80
    Sheet.Rows(1).Height = 40
    Sheet.Rows(2).Height = 40
    Sheet.Rows(3).Height = 80
    Sheet.Rows(r2).Height = 50
    For c1 As Integer = 0 To tbl.Cols.Count-1
        If tbl.Cols(c1).IsDate
            Sheet(r2+2,c1).Style = St2
        Else
            Sheet(r2+2,c1).Style = Style
        End If
    Next
Next




'打印设置
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("c:\reports\test.xls")
Dim Proc As New Process
Proc.File = "c:\reports\test.xls"
Proc.Start()



[此贴子已经被作者于2021/5/15 22:36:09编辑过]
 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		回复：（有点蓝）当前代码如下:Dim tbl As Table = Ta...  发帖心情 Post By：2021/5/16 14:05:00 [显示全部帖子]

老师  继续麻烦老师指导下了
当前遇到一个问题 表会新增多行  这个多行都是在  事件登记表的总记录数之上再加了五行  

图片点击可在新窗口打开查看此主题相关图片如下：2.png
图片点击可在新窗口打开查看
有没有办法实现  只按照事件登记表的总记录数增加行数   
而且增加的行数  必须是除掉了标题行和列标题行    （表标题2行 复杂表头2行）之外的行数等于事件登记表总记录数的行数   不要额外再新增其他行
假定已经设定了20条数据之后要强制换页    那么表中行数就应该是24行    
如果登记表记录数为18条，那么对应的补足24行后   完成24行的线框标注  
 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		回复：（有点蓝）给具体的单元格设置样式，不要整列设...  发帖心情 Post By：2021/5/16 21:40:00 [显示全部帖子]

强制换页这个已经设置好了的   
老师的指导我貌似没有明白呢

当前有如下问题：
1、怎么确保标题和列标题 行在换页后也显示呢?
2、
If tbl.Cols(c1).IsDate
            Sheet(r2,c1).Style = St2
        Else
            Sheet(r2,c1).Style = Style
        End If
标题和列标题都被画上线框

   If tbl.Cols(c1).IsDate
            Sheet(r2+2,c1).Style = St2
        Else
            Sheet(r2+2,c1).Style = Style
        End If
这个标题和列表不会画上线框   但是底部会额外新增多行   
这个问题有没有妥当的解决办法呢？
实现标题和列表标题不会被画上线框   底部也不会额外新增无效的行数
3、表格底部 是否也可以增加底部指定行数  注明为填表相关说明内容    该部分也随换页而和标题 列标题 一样显示在第二页呢？
 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		回复：（有点蓝）1、这个要使用vba控制http://www.fox...  发帖心情 Post By：2021/5/16 23:00:00 [显示全部帖子]

感谢老师的耐心指导

For r2 As Integer = 2 To Sheet.rows.count-1
    Sheet.Rows(0).Height = 80
    Sheet.Rows(1).Height = 40
    Sheet.Rows(2).Height = 40
    Sheet.Rows(3).Height = 80
    Sheet.Rows(r2).Height = 50
    For c1 As Integer = 0 To tbl.Cols.Count-1
        If tbl.Cols(c1).IsDate
            Sheet(r2,c1).Style = St2
        Else
            Sheet(r2,c1).Style = Style
        End If
    Next
Next

Sheet.Rows(27).PageBreak = True   '每页24行后强制换页
Sheet(25,0).Value="测试"
Sheet.MergeCell(25,0,1,32)
Sheet(26,0).Value="测试"
Sheet.MergeCell(26,0,1,32)
Sheet(27,0).Value="测试"
Sheet.MergeCell(27,0,1,32)
Sheet.Rows.Frozen = 4  '冻结表前面四行

当前已经解决了  表格行根据当前数据行进行对应增加行的问题  和  在换页符号后面增加文档底部说明问题

文档标题下一页继续显示问题  怎么操作呢？
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
在这个写法里面我找不到不打印指定行标题的内容  

老师提供的vba代码如下：
Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open("D:\Report.xls")
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
With Ws.PageSetup
    '设置打印区域
    .……
    .PrintTitleRows = Ws.Rows(1).Address '打印行标题(在每一页的顶部重复出现)
.PrintTitleRows = Ws.Rows(2).Address '打印行标题(在每一页的顶部重复出现)
.PrintTitleRows = Ws.Rows(3).Address '打印行标题(在每一页的顶部重复出现)
.PrintTitleRows = Ws.Rows(4).Address '打印行标题(在每一页的顶部重复出现)
    '设置页面
    .……
End With
App.Visible = True
Ws.PrintPreview
App.Quit

1、红色部分有没有办法变通实现在上面的sheet里面去呢？
2、红色部分想实现前面四行都在每一页顶部重复出现   运行结果只有最后一个第四行体现了效果  有没有办法让前面指定的四行出现在每一页的顶部呢？
3、25、26、27行是表的填写说明行   有没有办法实现对应的行也在每一页的对应行数出现呢？
4、如果当前页除了四行标题外  当数据不足20时，自动补充行至20行并勾画线框，这个功能怎么实现呢？特别是在换页后也要保持最少20行数据行
[此贴子已经被作者于2021/5/16 23:05:06编辑过]
 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		回复：（有点蓝）1、没有办法，只能另外处理2、认真看...  发帖心情 Post By：2021/5/17 1:31:00 [显示全部帖子]

参照老师的帮助  初步下述代码：
Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open("c:\reports\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 '横向打印
For i As Integer = 5 To 100 Step 5  '每5行就分页
    Ws.Rows(i).PageBreak = MSExcel.XlPageBreak.xlPageBreakManual
    Rg.Value = "Foxtable操控Excel全攻略"
Next
End With

App.Visible = True
Ws.PrintPreview
App.Quit
运行效果如下：【a3幅面  动画图可能看不大清楚】

此主题相关图片如下：动画111.gif
按此在新窗口浏览图片

对应的标题行现在是可以在每一个页面都显示了

但是：
红色部分代码对应的值  只在一个页面显示了  
没有在每一个页面都显示  是不是还需要一个遍历呢？
每5行分页  为什么某些页面没有五行呢？是不是哪里出错了？
老师可否帮忙指导下  怎么写？


楼上的
3、在每一个分页后面都另外添加3行说明行（25、26、27行的内容）
4、表格有多少行，和添加了多少行，都有索引可以计算的
比如dt1.Rows.Count等于15，那么就是多添加20-dt1.Rows.Count=5行空行
两个问题还是没有能够成功解决。
[此贴子已经被作者于2021/5/17 1:34:49编辑过]
 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		回复：（有点蓝）请上传实例说明  发帖心情 Post By：2021/5/17 11:30:00 [显示全部帖子]

项目例子已上传  麻烦老师帮忙看看  谢谢！
项目启动完毕后，先点启动服务，然后选择对应的fzbt1函数名称 点打开页面  即可运行代码  生成楼上对应的效果    
还有为什么会出现两次预览呢？

不大完美  麻烦老师帮忙看看了
以下内容是专门发给有点蓝浏览

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

图片点击可在新窗口打开查看此主题相关图片如下：动画111.gif
图片点击可在新窗口打开查看

[此贴子已经被作者于2021/5/17 11:37:20编辑过]
 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  9楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		回复：（有点蓝）麻烦新建一个项目，做个内部表的项目...  发帖心情 Post By：2021/5/17 18:06:00 [显示全部帖子]

两个格式都做了  麻烦老师看看

图片点击可在新窗口打开查看此主题相关图片如下：1.png
图片点击可在新窗口打开查看

以下内容是专门发给有点蓝浏览
 回到顶部
帅哥哟，离线，有人找我吗？
cnsjroom
 小大  10楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：七尾狐 帖子：1571 积分：11238 威望：0 精华：0 注册：2021/1/17 17:06:00 		回复：（有点蓝）[upload=zip,服务202105170253.zip]v...  发帖心情 Post By：2021/5/17 22:13:00 [显示全部帖子]

老师   我的加密狗版本4月到期了 不能打开当前5.12版本的  
老师是否可以直接告知一下代码呢？谢谢！
 回到顶部
总数 19 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.09473 秒, 7 次数据查询