EXCEL:宏考场考号打印

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

End Sub

Sub test2()

n = Worksheets.Count

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

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

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

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

posted @ 2021-03-30 11:35 myrj 阅读(423) 评论(0) 编辑收藏举报

会员力量，点亮园子希望

刷新页面返回顶部

myrj

EXCEL:宏 考场考号打印

公告

EXCEL:宏考场考号打印