按模版生成桌签PDF

一指禅62

myassz 发表于 2023-2-3 15:42
老师的程序是按考场生成的，与我的需求不一样。

因数据库中每个考场人数最多30人，生成的页面打印出来 ...

有一个修改文件在审核中

一指禅62

myassz 发表于 2023-2-3 15:42
老师的程序是按考场生成的，与我的需求不一样。

因数据库中每个考场人数最多30人，生成的页面打印出来 ...

看贴合需求不？

按座位号生成的PDF文件.zip (588.63 KB, 下载次数: 24)

2023-2-4 09:34 上传

点击文件名下载附件

全部代码截图

myassz

一指禅62 发表于 2023-2-4 09:35
看贴合需求不？

感谢！生成的页面大概是这个意思，但是不完全正确。排序和文件生成都是按“考点名称+考试时间”

myassz

andysky 发表于 2023-2-3 08:45
用 E灵 可以瞬间生所有标签，然后直接打印即可。
以下为操作动画：

谢谢！你这是按考场生成在同一页的，我要实现的功能不是这样的，是同一考场的考生自上而下生成在A4纸的同一位置

hjd528

一指禅62 发表于 2023-2-4 09:35
看贴合需求不？

如何修改，谢谢。 按考场生成考试桌签.rar (23.99 KB, 下载次数: 9)

2023-2-5 13:25 上传

点击文件名下载附件

一指禅62

myassz 发表于 2023-2-4 19:44
感谢！生成的页面大概是这个意思，但是不完全正确。排序和文件生成都是按“考点名称+考试时间”

一指禅62

myassz 发表于 2023-2-4 19:44
感谢！生成的页面大概是这个意思，但是不完全正确。排序和文件生成都是按“考点名称+考试时间”

代码自动生成的PDF文件.zip (1.2 MB, 下载次数: 19)

2023-2-9 20:03 上传

点击文件名下载附件

熊文来

请确认第27楼的文件是你要的最终的文件吗？

一指禅62

hjd528 发表于 2023-2-5 13:28
如何修改，谢谢。

1. Option Explicit
   
2. 
   
3. Private Function Cnn() As Object
   
4.     Set Cnn = CreateObject("adodb.connection")
   
5.     If Application.Version < 12 Then
   
6.         Cnn.Provider = "Microsoft.jet.OLEDB.4.0;Extended Properties=Excel 8.0"
   
7.     Else
   
8.         Cnn.Provider = "Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0"
   
9.     End If
   
10.     Cnn.Open ThisWorkbook.FullName
    
11. End Function
    
12. 
    
13. Sub 生成桌签()
    
14.     Dim i&, n%, SQL$, Rst As Object
    
15. 
    
16.     Dim Arr(1 To 30, 1 To 6), x%, y%, d As Object, k
    
17.     Set d = CreateObject("Scripting.Dictionary")
    
18.     Set Rst = CreateObject("adodb.Recordset")
    
19.    
    
20.     Rem 获取考场考场号
    
21.     If Rst.State = 1 Then Rst.Close
    
22.     Rst.Open "SELECT DISTINCT 考场号 FROM [考场库$]", Cnn, 1, 3
    
23.     Do While Not Rst.EOF
    
24.         d(Rst.Fields("考场号").Value) = ""
    
25.         Rst.MoveNext
    
26.     Loop
    
27.    
    
28.     Rem 开始编排生成文件
    
29.     Sheets("桌签模版").Select
    
30.     Application.ScreenUpdating = False
    
31.     Application.DisplayAlerts = False
    
32.     Range("A31:F65536").Clear
    
33. 
    
34.     For Each k In d.keys    '按考场生成文件夹
    
35.         If Rst.State = 1 Then Rst.Close
    
36.         SQL = "SELECT * FROM [考场库$] WHERE 考场号='" & k & "' ORDER BY 座位号"
    
37.         Rst.Open SQL, Cnn, 1, 3
    
38.         If Rst.RecordCount > 30 Then
    
39.             MsgBox k & "考场 人数为 " & Rst.RecordCount, vbCritical, "系统警告"
    
40.             Exit Sub
    
41.         End If
    
42.         Rem 记录按5行6列写入数组
    
43.         n = 0: x = 0: y = 1: Erase Arr
    
44.         Do While Not Rst.EOF
    
45.             n = n + 1
    
46.             x = (((n - 1) Mod 5)) * 6 + 1
    
47.             Arr(x + 1, y) = "座位号：" & Rst.Fields("座位号").Value
    
48.             Arr(x + 2, y) = "姓名：" & Rst.Fields("姓名").Value
    
49.             Arr(x + 3, y) = "班级：" & Rst.Fields("班级").Value
    
50.             Arr(x + 4, y) = "准考证号：" & Rst.Fields("准考证号").Value
    
51.             Rst.MoveNext
    
52.             If n Mod 5 = 0 Then y = y + 1
    
53.         Loop
    
54.         Rem 输出到文件指定位置
    
55.         Range("A1:F30") = Arr
    
56.         With ActiveSheet.PageSetup '设置页脚
    
57.             .LeftHeader = ""
    
58.             .CenterHeader = k & " 考 场 学 生 信 息"
    
59.             .RightHeader = ""
    
60.             .LeftFooter = ""
    
61.             .CenterFooter = ""
    
62.             .RightFooter = ""
    
63.         End With
    
64.    
    
65.         Rem 直接打印输出或保存为PDF文件，根据需要自行选择
    
66.         'Range("A1:F30").PrintOut    '直接打印输出
    
67. 
    
68.         Rem 另存为PDF文档
    
69.         Sheets("桌签模版").Copy
    
70.         ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=k & "考场学生信息.pdf", Quality:=xlQualityStandard, _
    
71.             IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    
72.         ActiveWorkbook.Close False
    
73.     Next
    
74.    
    
75.     Application.ScreenUpdating = True
    
76.     Application.DisplayAlerts = True
    
77.     Set d = Nothing
    
78.     Set Rst = Nothing
    
79. End Sub
    

复制代码

一指禅62

hjd528 发表于 2023-2-5 13:28
如何修改，谢谢。

按考场生成考试桌签_5行6列.zip (29.36 KB, 下载次数: 14)

2023-2-9 21:14 上传

点击文件名下载附件