求助，成绩汇总表打印控制按钮

zgcc2010zgcc

想在页面上加一个打印按钮，点击按钮整张表同时打印时，进行打印控制
一、班级与班级分开

二、打印的标题行手动设置完，每页打印25个人员，某个班级打印的最后一页不足25行，用相同行高的空行补上。





请帮忙，谢谢。

吧123456789

难倒是不难，就是懒的写

zorsite

看到用空行补齐我忽然就觉得……呃，这是个什么需求？
这是典型的报表输出需求，每个人需要的报表格式不一样，所以几乎每次都需要手工定制。
最烦就是用excel做报表了，真希望excel能够增加一种报表文件类型。
做出来的效果和楼主要的不一样，仅供参考。 成绩汇总表.rar (32.12 KB, 下载次数: 15)

2018-4-6 01:16 上传

点击文件名下载附件

1. Sub 打印()
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4. 
   
5.     Dim conn As Object, rs As Object
   
6.     Set conn = CreateObject("ADODB.connection")
   
7.     Set rs = CreateObject("ADODB.recordset")
   
8.     Dim connStr$, sqlStr$
   
9.     connStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
   
10.                 " Extended Properties=Excel 12.0;" & _
    
11.                 " Data Source=" & ThisWorkbook.FullName
    
12.     conn.Open connStr
    
13.    
    
14.     For Each sht In Worksheets '删除无用表
    
15.         If sht.Name <> "原表" Then sht.Delete
    
16.     Next
    
17.    
    
18.     arr = Array(1, 2, 3) '有几个班级
    
19.     For i = 0 To UBound(arr)
    
20.         sqlStr = "select 序号,班级,姓名,语文,数学,英语,物理,化学,总分 from [原表$] where 班级 = '" & arr(i) & "班'"
    
21.         Set rs = conn.Execute(sqlStr)
    
22.         Worksheets.Add after:=Worksheets(Worksheets.Count) '为每个班增加一张表
    
23.         With Worksheets(Worksheets.Count)
    
24.             .Name = arr(i) & "班成绩表"
    
25.             For j = 0 To rs.Fields.Count - 1 '写标题
    
26.                 .Cells(1, j + 1) = rs.Fields(j).Name
    
27.             Next
    
28.             .Range("A2").CopyFromRecordset rs '写入查询结果
    
29.             
    
30.             '下面全是格式美化
    
31.             With .UsedRange
    
32.                 .HorizontalAlignment = xlCenter '对齐
    
33.                 .VerticalAlignment = xlCenter
    
34.                 .Font.Name = "等线" '字体
    
35.                 .Font.Size = 10.5
    
36.                 .RowHeight = 23 '行高，23刚刚好，每页打印30个学生的成绩，基本上每个班2页纸打完
    
37.                 '美化标题行
    
38.                 With .Cells(1, 1).Resize(1, rs.Fields.Count)
    
39.                     With .Font
    
40.                         .Name = "黑体"
    
41.                         .Size = 11
    
42.                     End With
    
43.                     With .Interior
    
44.                         .ThemeColor = xlThemeColorDark1
    
45.                         .TintAndShade = -4.99893185216834E-02
    
46.                     End With
    
47.                 End With
    
48.                 '设置边框
    
49.                 With .Borders
    
50.                     .LineStyle = xlContinuous
    
51.                     .Weight = xlHairline
    
52.                 End With
    
53.                 '设置外边框
    
54.                 .BorderAround xlContinuous, xlThin
    
55.             End With
    
56.             
    
57.             '设置页眉页脚，打印标题行，居中
    
58.             With .PageSetup
    
59.                 .CenterHeader = "&""黑体,常规""&16 " & Year(Date) & "年" & arr(i) & "班成绩表"
    
60.                 .CenterFooter = "&10 第 &P 页  共 &N 页"
    
61.                 .CenterHorizontally = True
    
62.                 .PrintTitleRows = "$1:$1"
    
63.             End With
    
64.         End With
    
65.         Set rs = Nothing
    
66.     Next
    
67. conn.Close
    
68. Set conn = Nothing
    
69.     Application.ScreenUpdating = True
    
70.     Application.DisplayAlerts = True
    
71. End Sub
    

复制代码

zgcc2010zgcc

zorsite 发表于 2018-4-6 01:17
看到用空行补齐我忽然就觉得……呃，这是个什么需求？
这是典型的报表输出需求，每个人需要的报表格式不一 ...

谢谢帮忙。在最末页增加空行确实是个奇葩要求，不过是领导要求，没办法。

zorsite

zgcc2010zgcc 发表于 2018-4-6 09:43
谢谢帮忙。在最末页增加空行确实是个奇葩要求，不过是领导要求，没办法。

拿我的输出结果去给你们领导看吧，提高一下你们领导的审美能力。页眉什么的你可以自己设置。

zgcc2010zgcc

zorsite 发表于 2018-4-6 11:34
那我的输出结果去给你们领导看吧，提高一下你们领导的审美能力。页眉什么的你可以自己设置。

你好，加空行有办法吗？

zorsite

zgcc2010zgcc 发表于 2018-4-6 12:19
你好，加空行有办法吗？

你可以通过PageSetup.Pages.Count来获取页数，根据页数计算总行数，再根据总行数来设置边框，从而实现“加空行”。

zgcc2010zgcc

zorsite 发表于 2018-4-6 18:59
你可以通过PageSetup.Pages.Count来获取页数，根据页数计算总行数，再根据总行数来设置边框，从而实现“ ...

谢谢你的帮助

mjzxlmg

测试附件：
成绩汇总表.rar (39.24 KB, 下载次数: 9)

2018-4-7 08:51 上传

点击文件名下载附件

zgcc2010zgcc

mjzxlmg 发表于 2018-4-6 22:04
测试附件：

感谢帮助，谢谢。