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. Java 程序 关于Properties 类使用Store方法时不能会覆盖以前Properties 文件的内容

    F:\\Demo.properties 文件内容: #\u65B0\u589E\u4FE1\u606F#Wed Sep 14 11:16:24 CST 2016province=广东tt=近蛋city ...

  2. Auto ML自动调参

    Auto ML自动调参 本文介绍Auto ML自动调参的算法介绍及操作流程. 操作步骤 登录PAI控制台. 单击左侧导航栏的实验并选择某个实验. 本文以雾霾天气预测实验为例. 在实验画布区,单击左上角 ...

  3. Firfox、Chrome之python-selenium环境搭建

    公共步骤: 一.文件下载 下载地址: python安装包:https://www.python.org/getit/ PyCharm 安装包:http://www.jetbrains.com/pych ...

  4. 6, java数据结构和算法: 栈的应用, 逆波兰计算器, 中缀表达式--> 后缀表达式

    直接上代码: public class PolandCalculator { //栈的应用:波兰计算器: 即: 输入一个字符串,来计算结果, 比如 1+((2+3)×4)-5 结果为16 public ...

  5. 4.2tensorflow多层感知器MLP识别手写数字最易懂实例代码

    自己开发了一个股票智能分析软件,功能很强大,需要的点击下面的链接获取: https://www.cnblogs.com/bclshuai/p/11380657.html 1.1  多层感知器MLP(m ...

  6. 题解 P6622 [省选联考 2020 A/B 卷] 信号传递

    洛谷 P6622 [省选联考 2020 A/B 卷] 信号传递 题解 某次模拟赛的T2,考场上懒得想正解 (其实是不会QAQ), 打了个暴力就骗了\(30pts\) 就火速溜了,参考了一下某位强者的题 ...

  7. 【题解】逐个击破 luogu2700

    题目 题目描述: 现在有N个城市,其中K个被敌方军团占领了,N个城市间有N-1条公路相连,破坏其中某条公路的代价是已知的. 现在,告诉你K个敌方军团所在的城市,以及所有公路破坏的代价,请你算出花费最少 ...

  8. DOS命令行(10)——reg/regini-注册表编辑命令行工具

    注册表的介绍 注册表(Registry,台湾.港澳译作登錄檔)是Microsoft Windows中的一个重要的数据库,用于存储系统和应用程序的设置信息.   1. 数据结构 注册表由键(key,或称 ...

  9. 第二篇CTF-MISC

    第一篇写成了日记,发布不了.第一篇CTF-MISC 04.坚持60S 附件下载下来,是个jar的文件,打开 耶?这是嘛呀? 反正没看懂,既然是jar文件,直接上jd-gui反编译一波试试 这么明显的f ...

  10. Visual Studio Code 和Visual Studio插件收集(持续更新)

    Visual Studio Code 插件收集 Chinese (Simplified) Language Pack 默认刚安装的VSC是原味英文的,如果你用不习惯,非常简单,官方出品的简体中文语言包 ...