怎样实现批量自动分页打印

fushensong

表格在附件里，标了黄底色的自动在“数据”工作表中获取，要求不改变“明细”工作表的行数等格式，批量将“数据”工作表的数据填到“明细”工作表，自动分页。当打印到“数据”工作表中F列的“合计”所在行后，加上20-21的内容一起打印。在页脚自动生成“第？页，共？页”。然后强行另起一页开始打印。不知怎么解决，感谢帮忙。

xyxcc177

设置Recordset的pagesize属性，完成不难，前几天刚写过一个。

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   With Worksheets("数据")
   
5.     r = .Cells(.Rows.Count, 6).End(xlUp).Row
   
6.     arr = .Range("f2:l" & r)
   
7.   End With
   
8.   With Worksheets("明细")
   
9.     .Range("a5:h23").ClearContents
   
10.     m = 5
    
11.     For i = 1 To UBound(arr)
    
12.       If arr(i, 1) <> "合计" Then
    
13.         For j = 1 To UBound(arr, 2)
    
14.           .Cells(m, j) = arr(i, j)
    
15.         Next
    
16.         m = m + 1
    
17.         If m > 23 Then
    
18.           .PrintOut
    
19.           .Range("a5:h23").ClearContents
    
20.           m = 5
    
21.         End If
    
22.       Else
    
23.         .PrintOut
    
24.         .Range("a5:h23").ClearContents
    
25.         m = 5
    
26.       End If
    
27.     Next
    
28.   End With
    
29.    
    
30. End Sub
    
31. 
    

复制代码

chxw68

详见附件。

fushensong

chxw68 发表于 2018-9-19 09:27
详见附件。

你好，还有几个小问题没解决的：
1、XX村，XX组也自动填上
2、合计那行数据也要打印
3、在页脚加上“第？页，共？页”，自动统计每个组的总页数。
4、在每个组的最后一页加上20-21行的内容一起打印。
感谢您的帮助！

chxw68

fushensong 发表于 2018-9-19 09:43
你好，还有几个小问题没解决的：
1、XX村，XX组也自动填上
2、合计那行数据也要打印

都是小问题了，自己学着修改吧。

chxw68

fushensong 发表于 2018-9-19 09:43
你好，还有几个小问题没解决的：
1、XX村，XX组也自动填上
2、合计那行数据也要打印

你说的问题：
3、页脚是指的EXCEL页面页脚？
4、你说的是23-24行吧？每组前几页不打印这两行，只是在每组的最后一页打印这两行？

fushensong

chxw68 发表于 2018-9-19 10:03
你说的问题：
3、页脚是指的EXCEL页面页脚？
4、你说的是23-24行吧？每组前几页不打印这两行，只是在每 ...

是的，感谢您的回答

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr, zrr()
   
4.   With Worksheets("数据")
   
5.     r = .Cells(.Rows.Count, 6).End(xlUp).Row
   
6.     arr = .Range("d2:l" & r)
   
7.   End With
   
8.   xm = ""
   
9.   For i = 1 To UBound(arr)
   
10.     If arr(i, 1) & "+" & arr(i, 2) <> xm Then
    
11.       m = m + 1
    
12.       ReDim Preserve zrr(1 To 2, 1 To m)
    
13.       zrr(1, m) = i
    
14.       zrr(2, m) = i
    
15.       xm = arr(i, 1) & "+" & arr(i, 2)
    
16.     Else
    
17.       zrr(2, m) = i
    
18.     End If
    
19.   Next
    
20.   With Worksheets("明细")
    
21.     m = 4
    
22.     For k = 1 To UBound(zrr, 2)
    
23.       zys = Application.Ceiling((zrr(2, k) - zrr(1, k) + 1) / 19, 1)
    
24.       fys = 0
    
25.       For i = zrr(1, k) To zrr(2, k)
    
26.         If m = 4 Then
    
27.           .Range("b2:c2,a5:h22,a23:h24") = ""
    
28.           .Range("b2") = arr(i, 1)
    
29.           .Range("c2") = arr(i, 2)
    
30.         End If
    
31.         For j = 3 To UBound(arr, 2)
    
32.           .Cells(m, j - 2) = arr(i, j)
    
33.         Next
    
34.         m = m + 1
    
35.         If i = zrr(2, k) Then
    
36.           .Range("a23") = "申报依据：XXX  XXX"
    
37.           .Range("g23") = "登记时间：" & Format(Date, "yyyy年mm月dd日")
    
38.           .Range("a24") = "填表人："
    
39.         End If
    
40.         If m > 22 Or i = zrr(2, k) Then
    
41.           fys = fys + 1
    
42.           With .PageSetup
    
43.             .CenterFooter = "第" & fys & "页 共" & zys & "页"
    
44.           End With
    
45.           .PrintOut
    
46.           m = 4
    
47.         End If
    
48.       Next
    
49.     Next
    
50.   End With
    
51. End Sub

复制代码

chxw68

重新写了一段代码。