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. rman备份出现ORA-19625

    [oracle@hear adump]$ rman target / Recovery Manager: Release 11.2.0.4.0 - Production on Mon Jun 17 0 ...

  2. Jmeter- 笔记12 - 性能测试分析 & 性能测试流程

    性能测试分析 场景设计.监视图表: 设计场景:阶梯式.波浪式 监视器: 收集用于性能分析的数据:TPS图表.聚合报告\汇总报告.察看结果树.响应时间.吞吐量 服务器资源监控:cpu.内存.磁盘io 分 ...

  3. NVIDIA GPU的快速傅立叶变换

    NVIDIA GPU的快速傅立叶变换 cuFFT库提供GPU加速的FFT实现,其执行速度比仅CPU的替代方案快10倍.cuFFT用于构建跨学科的商业和研究应用程序,例如深度学习,计算机视觉,计算物理, ...

  4. 中国摄像头CMOS需求潜力旺盛

    中国摄像头CMOS需求潜力旺盛 CMOS是Complementary Metal Oxide Semiconductor(互补金属氧化物半导体)的缩写.它是指制造大规模集成电路芯片用的一种技术或用这种 ...

  5. YOLOvi(i=1,2,3,4)系列

    YOLOvi(i=1,2,3,4)系列 YOLOv4论文链接:https://arxiv.org/pdf/2004.10934.pdf YOLOv4源码链接:https://github.com/Al ...

  6. Charles下载及安装破解-自己编辑

    Charles下载地址 地址:https://www.charlesproxy.com/latest-release/download.do 2. Charles破解 破解地址:https://www ...

  7. eclipse左边的工程列表窗口不见了解决方案

    解决eclipse左边的工程列表窗口看不到工程目录的方法: Window->Show View->Project Explorer(如果没有Project Explorer选项,则Wind ...

  8. 如何实现一个简易版的 Spring - 如何实现 AOP(终结篇)

    前言 在 上篇 实现了 判断一个类的方式是符合配置的 pointcut 表达式.根据一个 Bean 的名称和方法名,获取 Method 对象.实现了 BeforeAdvice.AfterReturni ...

  9. 性能工具之linux三剑客awk、grep、sed详解

    前言 linux 有很多工具可以做文本处理,例如:sort, cut, split, join, paste, comm, uniq, column, rev, tac, tr, nl, pr, he ...

  10. Mybatis学习01:利用mybatis查询数据库

    通过mybatis来操作mysql数据库的步骤大致可分为以下几步: 在这里,我们以对下面这个这个表格进行操作为例: 表名:ssm 1 配置依赖 在pom.xml中添加所需要的的依赖 <!-- m ...