如何在每页后打印一个固定的表格

燕雀安知

Vicel 发表于 2015-5-6 21:37
另类的解题方法：循环隐藏行区域内容以达到每页后打印一个固定表格的效果

你这“另类”法叫人怎么评说呢？！

总之，在我看来，还叫不上“另类”，因为不具适用性。而且，代码存在明显错漏，甚至逻辑自相矛盾。

姑且当批改作业（托大了）：
1.当工作表不曾打印预览过或不曾分页预览过，运行你的代码会如何？
2.当第一页某一行或某些行畸高，从第2页起的后续各页你的代码打印输出的能有几行内容？
3.当指定了打印区域，你的代码能应付？
4.你的代码仅能打印输出工作表的最后几行，遑论其它工作表中的内容了（当然了，就本例来说，此点可忽略）。

结语：他人代码写得如此繁杂，一般情况下必有其道理，哪是廖廖几句代码就能解决的？而且本人早就有言，打印页面设置，历来烦杂。

Vicel

燕雀安知 发表于 2015-5-7 09:21
你这“另类”法叫人怎么评说呢？！

总之，在我看来，还叫不上“另类”，因为不具适用性。而且，代码存 ...

呵呵，你能！

我这里提供的代码是不具备通用性，只针对本帖问题提供一种解决问题的思路，仅此而已

Vicel

linyh1742595842 发表于 2015-5-6 16:38
老师！可否增加（第 x 页/共 x 页）的功能? 再加一个条件，打印时间。

几经修改，本代码通过inputbox选择底端需固定的区域，不再受工作表行高影响。
供参考，请测试

1. Sub test()
   
2.     Dim rng As Range, Rs&, r&, m&, n&, i&, T$
   
3.     With ActiveSheet
   
4.         Rs = .[A65536].End(xlUp).Row
   
5.         n = .HPageBreaks.Count
   
6.         If n = 0 Then
   
7.             .PrintOut
   
8.         ElseIf .HPageBreaks(1).Location.Row > Rs Then
   
9.             .PrintOut
   
10.         Else
    
11.             T = Now
    
12.             Set rng = Application.InputBox(Prompt:="请选择底端标题行", Title:="底端标题", Type:=8)
    
13.             If Not rng Is Nothing Then
    
14.                 r = rng.Row
    
15.                 If r > Rs Then Exit Sub
    
16.                 Application.ScreenUpdating = False
    
17.                 m = n * rng.Rows.Count
    
18.                 .Rows(r).Resize(m).Insert
    
19.                 n = .HPageBreaks.Count
    
20.                 If .HPageBreaks(n).Location.Row < .[A65536].End(xlUp).Row Then n = n + 1
    
21.                 .Rows(r).Resize(m).Delete
    
22.                 For i = 1 To n
    
23.                     .Rows("1:" & r - 1).Hidden = True
    
24.                     Do
    
25.                         s = s + 1
    
26.                         If s > r Then Exit Do
    
27.                         .Rows(s).Hidden = False
    
28.                         If .HPageBreaks.Count > 0 Then
    
29.                             If .HPageBreaks(1).Location.Row <= Rs Then
    
30.                                 Do
    
31.                                     .Rows(s).Hidden = True
    
32.                                     s = s - 1
    
33.                                 Loop Until .HPageBreaks.Count = 0
    
34.                             End If
    
35.                             Exit Do
    
36.                         End If
    
37.                     Loop
    
38.                     .PageSetup.CenterFooter = "第" & i & "页，共" & n & "页"
    
39.                     .PageSetup.RightHeader = T
    
40.                     .PrintOut
    
41.                 Next i
    
42.                 .Rows("1:" & r - 1).Hidden = False
    
43.                 .PageSetup.CenterFooter = ""
    
44.                 .PageSetup.RightHeader = ""
    
45.                 Set rng = Nothing
    
46.                 Application.ScreenUpdating = True
    
47.             End If
    
48.         End If
    
49.     End With
    
50. End Sub
    

复制代码

在每页后打印一个固定的表格.rar (23.66 KB, 下载次数: 63)

2015-5-7 14:47 上传

点击文件名下载附件

gaoch35

Vicel 发表于 2015-5-7 14:47
几经修改，本代码通过inputbox选择底端需固定的区域，不再受工作表行高影响。
供参考，请测试

大师，帮帮忙，比较并记录某一列完全相同的单元格相差的行数
http://club.excelhome.net/thread-1203637-1-1.html

fantasy456

Vicel 发表于 2015-5-7 14:47
几经修改，本代码通过inputbox选择底端需固定的区域，不再受工作表行高影响。
供参考，请测试

测试了，确实是表头没有了，原来的打印标题设置好像对这个无效呀！

yjwdjfqb

Vicel 发表于 2015-5-7 14:47
几经修改，本代码通过inputbox选择底端需固定的区域，不再受工作表行高影响。
供参考，请测试

老师你好，我加了设置固定表头的代码，不成功，请帮修改下好吧，谢谢你了老师！

1.     On Error Resume Next
   
2.     Set Regional = Application.InputBox("请选择固定表头，行！", "提示", , , , , Type:=8)
   
3.     If Regional Is Nothing Then Exit Sub
   
4. 
   
5.     With ActiveSheet.PageSetup
   
6.         .PrintTitleRows = Regional.EntireRow.address    '表示选区整行地址
   
7.     End With

复制代码