利用VBA实现自动排列打印考试座次表

1、用实现自动排列、打印考试座次表考试是学校考查教师教学效果，教师了解学生学习情况，从而提高教学质量的一项常规工作，也是国家选拔人才的重要手段。编排考试座次表这种简单重复的工作，以前考务人员采用复制、粘贴的手段来编排、打印，耗费了大量时间和精力。本人利用制作的这个软件，能自动编排打印考试座次表，从而轻松完成上述工作，为你节约大量的时间和精力。一、准备工作、在xcel中建立一个有张工作表的工作薄，将其名称分别改为：考生名单、人顺序打印、按人首尾相连、按人首尾相连、按人首尾相连；、将“考生名单”工作表按如图格式建好，要求：第一行为标题，第一列存放考号数据，第二列存放班次数据，第三列为姓名，以后各列可有

2、可无，然后按考号（或班次或总分等）排好顺序。、将工作表“顺序打印”、“按人首尾相连”、“按人首尾相连”、“按人首尾相连”分别按图、图、图、图格式建好。其中标题文字、行列的宽高、字体、字型、字号等可按自己的需要作相应的改动。图二、编写代码、 按“人顺序打印”代码在“人顺序打印”工作表中添加一个“按钮”控件，在“指定宏”窗口中将宏名改为“人顺序打印”，单击新建，然后在代码窗口中输入以下头代码：Sub 按40人打印()Dim ipage As Integer, page As Integer, line As Integer, x As Integer,y as Integer, icount As

3、 IntegerApplication.ScreenUpdating = Trueicount = Sheets(考生名单).a1.CurrentRegion.Rows.Count 1 /统计考生人数If icount / 40 = Int(icount / 40) Then /计算考室数 ipage = icount / 40Else ipage = Int(icount / 40) + 1End IfSheets(40人顺序打印).SelectFor page = 0 To ipage 1 /为1至最后考室编排座次 Cells(1, 10) = page + 1 /在第一行第十列填写考室序

4、号 line = page * 40 + 2 /在”考生名单”中查找本考室第一列第一名考生 For x = 4 To 11 /为4至11行填写数据 For y=1 to 19 /为每一行中1至9列中不被4整除的列填写考号、班次、姓名 if y/4int(y/4) thencells(x,y)=Sheets(考生名单).Cells(line+(int(y/4)*8),y-int(y/4)*4) /将”考生名单”中”考号”、“班次”、End If /“姓名”填入座次表相应座位中Next y line = line + 1 /考生下移一位 Next x Sheets(40人顺序打印).PrintOu

5、t /打印本考室座次表Next pageEnd Sub图、 “按人首尾相连”打印代码操作如前“人顺序打印”，代码如下（部分语句注解同前）：Sub 按30人首尾相连()Dim ipage As Integer, page As Integer, line As Integer, x As Integer, y As Integer,icount As IntegerApplication.ScreenUpdating = Trueicount = Sheets(考生名单).a1.CurrentRegion.Rows.Count - 1If icount / 30 = Int(icount / 3

6、0) Then ipage = icount / 30Else ipage = Int(icount / 30) + 1End IfSheets(按30人首尾相连).SelectFor page = 0 To ipage - 1 Cells(1, 8) = page + 1 line = page * 30 + 2 /查找第一列第一位考生 For x = 4 To 11 /填写考室第一列考生数据For y= 1 to 3 /填写本列每一考生数据 Cells(x, y) = Sheets(考生名单).Cells(line, y)Next y line = line + 1 /考生下移一位 Nex

7、t x line = page * 30 + 16 /查找第二列第一位考生 For x = 5 To 11 /填写考室第二列考生数据 For y = 5 To 7 /填写本列每一考生数据 Cells(x, y) = Sheets(考生名单).Cells(line, y - 4) Next y line = line 1 /考生前移一位 Next x line = page * 30 + 17 /查找第三列第一位考生 For x = 5 To 11 /填写考室第三列考生数据 For y = 9 To 11 Cells(x, y) = Sheets(考生名单).Cells(line, y - 8)

8、 Next y line = line + 1 /考生下移一位 Next x line = page * 30 + 31 /查找第四列第一位考生 For x = 4 To 11 /填写考室第四列考生数据 For y = 13 To 15 Cells(x, y) = Sheets(考生名单).Cells(line, y - 12) Next y line = line 1 / /考生前移一位 Next xSheets(按30人首尾相连).PrintOutNext pageEnd Sub图、 “按人首尾相连”打印代码操作如前“人顺序打印”，代码如下（部分语句注解同前）：Sub 按40人首尾相连()

9、Dim ipage As Integer, page As Integer, line As Integer, x As Integer, y As Integer, icount As IntegerApplication.ScreenUpdating = Trueicount = Sheets(考生名单).a1.CurrentRegion.Rows.Count - 1If icount / 40 = Int(icount / 40) Then ipage = icount / 40Else ipage = Int(icount / 40) + 1End IfSheets(按40人首尾相连)

10、.SelectFor page = 0 To ipage - 1 Cells(1, 10) = page + 1 line = page * 40 + 2 For y = 1 To 5 For x = 4 To 11 If y / 2 Int(y / 2) Then /排列奇数列考生数据，下面三行语也可采用一个循环语句实现 Cells(x, (y - 1) * 4 + 1) = Sheets(考生名单).Cells(line + (y - 1) * 8, 1) Cells(x, (y - 1) * 4 + 2) = Sheets(考生名单).Cells(line + (y - 1) * 8,

11、2) Cells(x, (y - 1) * 4 + 3) = Sheets(考生名单).Cells(line + (y - 1) * 8, 3) line = line + 1 Else /填写偶数列考生数据 Cells(x, (y - 1) * 4 + 1) = Sheets(考生名单).Cells(line + (y - 1) * 8 - 1, 1) Cells(x, (y - 1) * 4 + 2) = Sheets(考生名单).Cells(line + (y - 1) * 8 - 1, 2) Cells(x, (y - 1) * 4 + 3) = Sheets(考生名单).Cells(

12、line + (y - 1) * 8 - 1, 3) line = line - 1 End If Next x Next ySheets(按40人首尾相连).PrintOutNext pageEnd Sub图、 “按人首尾相连”打印代码操作如前“人顺序打印”，代码如下（部分语句注解同前）：Sub 按50人首尾相连()Dim ipage As Integer, page As Integer, line As Integer, x As Integer, y As Integer, icount As IntegerApplication.ScreenUpdating = Trueicount

13、 = Sheets(考生名单).a1.CurrentRegion.Rows.Count - 1If icount / 50 = Int(icount / 50) Then ipage = icount / 50Else ipage = Int(icount / 50) + 1End IfSheets(按50人首尾相连).SelectFor page = 0 To ipage - 1 Cells(1, 9) = page + 1 line = page * 50 + 2 For y = 1 To 5 For x = 4 To 13 If y / 2 Int(y / 2) Then Cells(x

14、, (y - 1) * 4 + 1) = Sheets(考生名单).Cells(line + (y - 1) * 10, 1) Cells(x, (y - 1) * 4 + 2) = Sheets(考生名单).Cells(line + (y - 1) * 10, 2) Cells(x, (y - 1) * 4 + 3) = Sheets(考生名单).Cells(line + (y - 1) * 10, 3) line = line + 1 Else Cells(x, (y - 1) * 4 + 1) = Sheets(考生名单).Cells(line + (y - 1) * 10 - 1, 1) Cells(x, (y - 1) * 4 + 2) = Sheets(考生名单).Cells(line + (y - 1) * 10 - 1