Sub addwork()

Rem 当前宏是根据学生数量 、每考场人数计算工作表数
Dim i As Integer
Rem xx为每个考场的人数
Rem yy为当前专业标记
Rem mm为当前专业考生人数
Rem shu为当前专业考号张数
Rem shuu为当前专业考场数量
xx = 44
yy = 2001
mm = 999

If Int(mm / xx) = mm / xx Then
shuu = mm / xx
ElseIf Int(mm / xx) <> mm / xx Then
shuu = Int(mm / xx) + 1
End If
If Int(mm / 30) = mm / 30 Then
shu = mm / 30
ElseIf Int(mm / 30) <> mm / 30 Then
shu = Int(mm / 30) + 1
End If

For i = 1 To 2 * shuu
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "机" & i

Next

End Sub

Sub test2()

n = Worksheets.Count

Rem 计算当前所有工作表数量
Rem xx为每个考场的人数
Rem yy为当前专业标记
Rem mm为当前专业考生人数
Rem shu为当前专业考号张数
Rem shuu为当前专业考场数量
xx = 44
yy = 2001
mm = 999

If Int(mm / xx) = mm / xx Then
shuu = mm / xx
ElseIf Int(mm / xx) <> mm / xx Then
shuu = Int(mm / xx) + 1
End If
If Int(mm / 30) = mm / 30 Then
shu = mm / 30
ElseIf Int(mm / 30) <> mm / 30 Then
shu = Int(mm / 30) + 1
End If

bz = 0
For i = 1 To 2 * shuu
Worksheets(i).Activate
tmp = (i) & "月"

Rem 得到当前激活表的名称,再形成需要修改的的工作表名称
Rem [a1:c10].Copy Sheets(tmp).[a1]
Rows("1:10").RowHeight = 72
Columns("A:C").ColumnWidth = 31
Range("A1:c10").Font.Name = "宋体"
Range("A1:c10").Font.Bold = True
Range("A1:c10").Font.Size = 36
abb = 30 * (i - 1) + 1
lena = Len(abb)
If bz = 1 Then
abb = ab + 1
ElseIf bz = 2 Then
abb = ab + 2
ElseIf bz = 3 Then
abb = ab + 3
ElseIf bz = 4 Then
abb = ab + 3
End If

For ii = 1 To 10
ab = abb + (ii - 1) * 3
If (ab / xx) = Int(ab / xx) Then
If Len(ab + 1) = 1 Then
If Len(ab) = 1 Then
If ab <= mm Then
Range("a" & ii) = yy & 0 & ab
Else
Exit For
End If
ElseIf Len(ab) = 2 Then
If ab <= mm Then
Range("a" & ii) = yy & 0 & ab
Else
Exit For
End If
ElseIf Len(ab) = 3 Then
If ab <= mm Then
Range("a" & ii) = yy & ab
Else
Exit For
End If
End If
bz = 1
Exit For
ElseIf Len(ab + 1) = 2 Then
If Len(ab) = 1 Then
If ab <= mm Then
Range("a" & ii) = yy & 0 & ab
Else
Exit For
End If
ElseIf Len(ab) = 2 Then
If ab <= mm Then
Range("a" & ii) = yy & 0 & ab
Else
Exit For
End If
ElseIf Len(ab) = 3 Then
If ab <= mm Then
Range("a" & ii) = yy & ab
Else
Exit For
End If
End If
bz = 1
Exit For
ElseIf Len(ab + 1) = 3 Then
If Len(ab) = 1 Then
If ab <= mm Then
Range("a" & ii) = yy & 0 & ab
Else
Exit For
End If
ElseIf Len(ab) = 2 Then
If ab <= mm Then
Range("a" & ii) = yy & 0 & ab
Else
Exit For
End If
ElseIf Len(ab) = 3 Then
If ab <= mm Then
Range("a" & ii) = yy & ab
Else
Exit For
End If
End If
bz = 1
Exit For

End If
End If
If (ab + 1) / xx = Int((ab + 1) / xx) Then
If Len(ab + 1) = 1 Then
If Len(ab) = 1 Then
If ab <= mm Then
Range("a" & ii) = yy & 0 & ab
Else
Exit For
End If
ElseIf Len(ab) = 2 Then
If ab <= mm Then
Range("a" & ii) = yy & 0 & ab
Else
Exit For
End If
ElseIf Len(ab) = 3 Then
If ab <= mm Then
Range("a" & ii) = yy & ab
Else
Exit For
End If
End If
If Len(ab + 1) = 1 Then
If ab + 1 <= mm Then
Range("b" & ii) = yy & 0 & (ab + 1)
Else
Exit For
End If
ElseIf Len(ab + 1) = 2 Then
If ab + 1 <= mm Then
Range("b" & ii) = yy & 0 & (ab + 1)
Else
Exit For
End If
ElseIf Len(ab + 1) = 3 Then
If ab + 1 <= mm Then
Range("b" & ii) = yy & (ab + 1)
Else
Exit For
End If
End If
bz = 2
Exit For
ElseIf Len(ab + 1) = 2 Then
If Len(ab) = 1 Then
If ab <= mm Then
Range("a" & ii) = yy & 0 & ab
Else
Exit For
End If
ElseIf Len(ab) = 2 Then
If ab <= mm Then
Range("a" & ii) = yy & 0 & ab
Else
Exit For
End If
ElseIf Len(ab) = 3 Then
If ab <= mm Then
Range("a" & ii) = yy & ab
Else
Exit For
End If
End If
If Len(ab + 1) = 1 Then
If ab + 1 <= mm Then
Range("b" & ii) = yy & 0 & (ab + 1)
Else
Exit For
End If
ElseIf Len(ab + 1) = 2 Then
If ab + 1 <= mm Then
Range("b" & ii) = yy & 0 & (ab + 1)
Else
Exit For
End If
ElseIf Len(ab + 1) = 3 Then
If ab + 1 <= mm Then
Range("b" & ii) = yy & (ab + 1)
Else
Exit For
End If
End If
bz = 2
Exit For
ElseIf Len(ab + 1) = 3 Then
If Len(ab) = 1 Then
If ab <= mm Then
Range("a" & ii) = yy & 0 & ab
Else
Exit For
End If
ElseIf Len(ab) = 2 Then
If ab <= mm Then
Range("a" & ii) = yy & 0 & ab
Else
Exit For
End If
ElseIf Len(ab) = 3 Then
If ab <= mm Then
Range("a" & ii) = yy & ab
Else
Exit For
End If
End If
If Len(ab + 1) = 1 Then
If ab + 1 <= mm Then
Range("b" & ii) = yy & 0 & (ab + 1)
Else
Exit For
End If

ElseIf Len(ab + 1) = 2 Then
If ab + 1 <= mm Then
Range("b" & ii) = yy & 0 & (ab + 1)
Else
Exit For
End If

ElseIf Len(ab + 1) = 3 Then
If ab + 1 <= mm Then
Range("b" & ii) = yy & (ab + 1)
Else
Exit For
End If
End If
bz = 2
Exit For

End If
End If
If (ab + 2) / xx = Int((ab + 2) / xx) Then
If Len(ab + 2) = 1 Then
If Len(ab) = 1 Then
If ab <= mm Then
Range("a" & ii) = yy & 0 & ab
Else
Exit For
End If
ElseIf Len(ab) = 2 Then
If ab <= mm Then
Range("a" & ii) = yy & 0 & ab
Else
Exit For
End If
ElseIf Len(ab) = 3 Then
If ab <= mm Then
Range("a" & ii) = yy & ab
Else
Exit For
End If
End If
If Len(ab + 1) = 1 Then
If ab + 1 <= mm Then
Range("b" & ii) = yy & 0 & (ab + 1)
Else
Exit For
End If
ElseIf Len(ab + 1) = 2 Then
If ab + 1 <= mm Then
Range("b" & ii) = yy & 0 & (ab + 1)
Else
Exit For
End If
ElseIf Len(ab + 1) = 3 Then
If ab + 1 <= mm Then
Range("b" & ii) = yy & (ab + 1)
Else
Exit For
End If
End If
If Len(ab + 2) = 1 Then
If ab + 2 <= mm Then
Range("c" & ii) = yy & 0 & (ab + 2)
Else
Exit For
End If
ElseIf Len(ab + 2) = 2 Then
If ab + 2 <= mm Then
Range("c" & ii) = yy & 0 & (ab + 2)
Else
Exit For
End If
ElseIf Len(ab + 2) = 3 Then
If ab + 2 <= mm Then
Range("c" & ii) = yy & (ab + 2)
Else
Exit For
End If
End If
bz = 3
Exit For
ElseIf Len(ab + 2) = 2 Then
If Len(ab) = 1 Then
If ab <= mm Then
Range("a" & ii) = yy & 0 & ab
Else
Exit For
End If
ElseIf Len(ab) = 2 Then
If ab <= mm Then
Range("a" & ii) = yy & 0 & ab
Else
Exit For
End If
ElseIf Len(ab) = 3 Then
If ab <= mm Then
Range("a" & ii) = yy & ab
Else
Exit For
End If
End If
If Len(ab + 1) = 1 Then
If ab + 1 <= mm Then
Range("b" & ii) = yy & 0 & (ab + 1)
Else
Exit For
End If
ElseIf Len(ab + 1) = 2 Then
If ab + 1 <= mm Then
Range("b" & ii) = yy & 0 & (ab + 1)
Else
Exit For
End If
ElseIf Len(ab + 1) = 3 Then
If ab + 1 <= mm Then
Range("b" & ii) = yy & (ab + 1)
Else
Exit For
End If
End If
If Len(ab + 2) = 1 Then
If ab + 2 <= mm Then
Range("c" & ii) = yy & 0 & (ab + 2)
Else
Exit For
End If
ElseIf Len(ab + 2) = 2 Then
If ab + 2 <= mm Then
Range("c" & ii) = yy & 0 & (ab + 2)
Else
Exit For
End If
ElseIf Len(ab + 2) = 3 Then
If ab + 2 <= mm Then
Range("c" & ii) = yy & (ab + 2)
Else
Exit For
End If
End If
bz = 3
Exit For
ElseIf Len(ab + 2) = 3 Then
If Len(ab) = 1 Then
If ab <= mm Then
Range("a" & ii) = yy & 0 & ab
Else
Exit For
End If
ElseIf Len(ab) = 2 Then
If ab <= mm Then
Range("a" & ii) = yy & 0 & ab
Else
Exit For
End If
ElseIf Len(ab) = 3 Then
If ab <= mm Then
Range("a" & ii) = yy & ab
Else
Exit For
End If
End If
If Len(ab + 1) = 1 Then
If ab + 1 <= mm Then
Range("b" & ii) = yy & 0 & (ab + 1)
Else
Exit For
End If
ElseIf Len(ab + 1) = 2 Then
If ab + 1 <= mm Then
Range("b" & ii) = yy & 0 & (ab + 1)
Else
Exit For
End If
ElseIf Len(ab + 1) = 3 Then
If ab + 1 <= mm Then
Range("b" & ii) = yy & (ab + 1)
Else
Exit For
End If
End If
If Len(ab + 2) = 1 Then
If ab + 2 <= mm Then
Range("c" & ii) = yy & 0 & (ab + 2)
Else
Exit For
End If
ElseIf Len(ab + 2) = 2 Then
If ab + 2 <= mm Then
Range("c" & ii) = yy & 0 & (ab + 2)
Else
Exit For
End If
ElseIf Len(ab + 2) = 3 Then
If ab + 2 <= mm Then
Range("c" & ii) = yy & (ab + 2)
Else
Exit For
End If
End If
bz = 3
Exit For
End If
End If
If Len(ab) = 1 Then

If Len(ab) = 1 Then
If ab <= mm Then
Range("a" & ii) = yy & 0 & 0 & ab
Else
Exit For
End If
ElseIf Len(ab) = 2 Then
If ab <= mm Then
Range("a" & ii) = yy & 0 & ab
Else
Exit For
End If
ElseIf Len(ab) = 3 Then
If ab <= mm Then
Range("a" & ii) = yy & ab
Else
Exit For
End If
End If
If Len(ab + 1) = 1 Then
If ab + 1 <= mm Then
Range("b" & ii) = yy & 0 & 0 & (ab + 1)
Else
Exit For
End If
ElseIf Len(ab + 1) = 2 Then
If ab + 1 <= mm Then
Range("b" & ii) = yy & 0 & (ab + 1)
Else
Exit For
End If
ElseIf Len(ab + 1) = 3 Then
If ab + 1 <= mm Then
Range("b" & ii + 1) = yy & (ab + 1)
Else
Exit For
End If
End If
If Len(ab + 2) = 1 Then
If ab + 2 <= mm Then
Range("c" & ii) = yy & 0 & 0 & (ab + 2)
Else
Exit For
End If

ElseIf Len(ab + 2) = 2 Then
If ab + 2 <= mm Then
Range("c" & ii) = yy & 0 & (ab + 2)
Else
Exit For
End If

ElseIf Len(ab + 2) = 3 Then
If ab + 2 <= mm Then
Range("c" & ii) = yy & (ab + 2)
Else
Exit For
End If
End If
bz = 4
ElseIf Len(ab) = 2 Then

If Len(ab) = 1 Then
If ab <= mm Then
Range("a" & ii) = yy & 0 & ab
Else
Exit For
End If
ElseIf Len(ab) = 2 Then
If ab <= mm Then
Range("a" & ii) = yy & 0 & ab
Else
Exit For
End If
ElseIf Len(ab) = 3 Then
If ab <= mm Then
Range("a" & ii) = yy & ab
Else
Exit For
End If
End If
If Len(ab + 1) = 1 Then
If ab + 1 <= mm Then
Range("b" & ii) = yy & 0 & (ab + 1)
Else
Exit For
End If
ElseIf Len(ab + 1) = 2 Then
If ab + 1 <= mm Then
Range("b" & ii) = yy & 0 & (ab + 1)
Else
Exit For
End If
ElseIf Len(ab + 1) = 3 Then
If ab + 1 <= mm Then
Range("b" & ii) = yy & (ab + 1)
Else
Exit For
End If
End If
If Len(ab + 2) = 1 Then
If ab + 2 <= mm Then
Range("c" & ii) = yy & 0 & (ab + 2)
Else
Exit For
End If
ElseIf Len(ab + 2) = 2 Then
If ab + 2 <= mm Then
Range("c" & ii) = yy & 0 & (ab + 2)
Else
Exit For
End If
ElseIf Len(ab + 2) = 3 Then
If ab + 2 <= mm Then
Range("c" & ii) = yy & (ab + 2)
Else
Exit For
End If
End If
bz = 4
ElseIf Len(ab) = 3 Then

If Len(ab) = 1 Then
If ab <= mm Then
Range("a" & ii) = yy & 0 & ab
Else
Exit For
End If
ElseIf Len(ab) = 2 Then
If ab <= mm Then
Range("a" & ii) = yy & 0 & ab
Else
Exit For
End If
ElseIf Len(ab) = 3 Then
If ab <= mm Then
Range("a" & ii) = yy & ab
Else
Exit For
End If
End If
If Len(ab + 1) = 1 Then
If ab + 1 <= mm Then
Range("b" & ii) = yy & 0 & (ab + 1)
Else
Exit For
End If
ElseIf Len(ab + 1) = 2 Then
If ab + 1 <= mm Then
Range("b" & ii) = yy & 0 & (ab + 1)
Else
Exit For
End If
ElseIf Len(ab + 1) = 3 Then
If ab + 1 <= mm Then
Range("b" & ii) = yy & (ab + 1)
Else
Exit For
End If
End If
If Len(ab + 2) = 1 Then
If ab + 2 <= mm Then
Range("c" & ii) = yy & 0 & (ab + 2)
Else
Exit For
End If
ElseIf Len(ab + 2) = 2 Then
If ab + 2 <= mm Then
Range("c" & ii) = yy & 0 & (ab + 2)
Else
Exit For
End If
ElseIf Len(ab + 2) = 3 Then
If ab + 2 <= mm Then
Range("c" & ii) = yy & (ab + 2)
Else
Exit For
End If
End If
bz = 4

End If
Next
Rem ab = ab - 3
Rem 激活第i个工作表

Rem 复制当前活动工作表的D4:H10区域,到目标工作表的D4单元格粘贴

Application.Wait Now + TimeValue("0:00:2")

Rem 延时4秒

Next
End Sub

Rem 形成工作表后,选择全部工作表再进行页面设置,再打印所有活动工作表即可

Sub test2a()

Rem 打印场标
Rem 打印页面设置A4 横向

Dim i As Integer

For i = 1 To 1
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "机" & i

Next

Rows("1:1").RowHeight = 171.75
Rows("2:2").RowHeight = 123.75
Columns("A:A").ColumnWidth = 130.5
Range("A1:c10").Font.Name = "宋体"
Range("A1:c10").Font.Bold = True
Range("A1:A1").Font.Size = 90
Range("A2:A2").Font.Size = 60
Range("A1:a2").HorizontalAlignment = xlCenter
Range("a" & 1) = "计算机考场1"
Range("a" & 2) = "考号(2003055-2003108)"
End Sub

EXCEL:宏 考场考号打印的更多相关文章

  1. VBA:考场场标打印

    Function pda(x) a = x If Len(a) = 1 Then ab = "00" & a ElseIf Len(a) = 2 Then ab = &qu ...

  2. Excel宏录制、数据透视表、合并多个页签

    前段时间做数据分析的时候,遇到很多报表文件需要处理,在此期间学习了很多Excel操作,特此做笔记回顾. Excel宏录制 打开开发者工具 打开Excel文件,选择”文件”-->“选项”--> ...

  3. C#巧用Excel模版变成把Table打印出来

    将一个做好的Excel模版,通过程序填上数据然后打印出来这个需求有两种方法一种是通过代码打开Excel模版然后填入数据然后再打印. 第二种方法就是我将要介绍的 1.将Excel设置好格式另存为HTML ...

  4. 如何破解excel宏的密码

    http://zhidao.baidu.com/question/140107193.html 最近下载了一个excel模板,使用excel宏编的,但实际需要需更改一下,但是他设置了工作表密码保护,谁 ...

  5. C语言宏与单井号(#)和双井号(##)

    C(和C++)中的宏(Macro)属于编译器预处理的范畴,属于编译期概念(而非运行期概念).下面对常遇到的宏的使用问题做了简单总结.关于#和##在C语言的宏中,#的功能是将其后面的宏参数进行字符串化操 ...

  6. 如何使用Excel和Word编辑和打印条形码

    本文介绍如何使用Microsoft Office Excel 2007和Microsoft Office Word 2007进行条形码的编辑后,通过普通的办公打印机将条形码打印出来. 对于少量,简单的 ...

  7. Excel 宏

    实现1到40行的第一列 ,全部 累加一个字符串 A1 Sub Macro1() Dim i As IntegerFor i = 1 To 40Sheets(1).Cells(i, 1).Value = ...

  8. zf-关于邵阳市打印模块个别单号打印之后不会跳转到收费模块的BUG的解决方法

    原因是 办结的时候 有个收费管理,里面会生成收费项目的单号,但是有1个单号是有问题的,没有关联到数据库里面的其他的表,所以打印之后不能跳转.如果跳转到收费模块 那么数据库里面的一个flag字段会变成9 ...

  9. Excel—宏表函数

    首先有一个知识点,宏表函数是不能直接在单元格中写公式的,需要先定义一个名称(“公式”选项卡——“定义名称”),然后在“定义名称”中的“定义位置”中写入宏表函数. GET.CELL(调取单元格信息的函数 ...

随机推荐

  1. Proteus中包含的传感器类型(Transducers)

    1. 传感器列表 2. 部分传感器的测量电路 (1)光照传感器,搭采样电阻,测电压输出. (2)距离传感器,带采样电阻,测电压输出. (3)粉尘传感器,测PWM脉宽 其余传感器多为总线类型的传感器,各 ...

  2. 英特尔® 至强® 平台集成 AI 加速构建数据中心智慧网络

    英特尔 至强 平台集成 AI 加速构建数据中心智慧网络 SNA 通过 AI 方法来实时感知网络状态,基于网络数据分析来实现自动化部署和风险预测,从而让企业网络能更智能.更高效地为最终用户业务提供支撑. ...

  3. 后缀数组&manachar总结

    洛谷题单 后缀数组 前置芝士 后缀数组 1 后缀数组 2 后缀数组 3 例题略解 P2463 [SDOI2008]Sandy的卡片 板子题... 然而我还是不会. 大概做法就是先把所有的串差分后拼成一 ...

  4. noip2006总结

    T1 能量项链 原题 在Mars星球上,每个Mars人都随身佩带着一串能量项链.在项链上有N颗能量珠.能量珠是一颗有头标记与尾标记的珠子,这些标记对应着某个正整数.并且,对于相邻的两颗珠子,前一颗珠子 ...

  5. tree (一本通练习||清华集训互测)

    tree 内存限制:512 MiB 时间限制:3000 ms 标准输入输出 题目类型:传统 评测方式:文本比较   题目描述 给你一个无向带权连通图,每条边是黑色或白色.让你求一棵最小权的恰好有nee ...

  6. MySQL 数据库设计的“奥秘”

    2 MySQL 数据库设计的"奥秘" [主题]逻辑设计:数据类型与 Schema 所谓"万丈高楼平地起",一个稳固的建筑离不开扎实的基础.同样,良好的的「逻辑设 ...

  7. Java新一代单元测试框架JUnit5速览

    为什么学JUnit5 Java技术栈的单元测试框架有两个:JUnit和TestNG,有种说法是TestNG比JUnit更强大,学TestNG就够了,但是当我打开GitHub看到star的时候,犹豫了: ...

  8. vs中打开ashx文件没有提示,没有高亮标记解决方法

    在VS菜单中 工具 --- 选项 --- 文本编辑器 --- 文件扩展名,在右侧添加 ashx ,选中Microsoft Visual C# 保存后,再打开就行了 ashx文件头部报错后,删除 < ...

  9. Go语言十六进制转十进制

    Go语言十六进制转十进制 代码Demo import ( "fmt" "strconv" "testing" ) func Test_1(t ...

  10. Linux中useradd的用法

    语法:useradd [选项] 用户名 选项: -d<登陆目录> 指定新用户登陆的起始目录,默认为/home -e<有效期限> 指定用户的有效期限,格式为 YYYY-MM-DD ...