VBA:考场场标打印
阅读原文时间:2023年07月09日阅读:2

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

End If
pda = ab
End Function
Sub yy()
Worksheets.Select
With ActiveSheet.PageSetup

.LeftMargin = Application.CentimetersToPoints(0.5)

.RightMargin = Application.CentimetersToPoints(0.5)

.TopMargin = Application.CentimetersToPoints(2.5) '顶边距  
.Orientation = xlLandscape '纵向 xlPortait横向

.BottomMargin = Application.CentimetersToPoints(1) '底

.HeaderMargin = Application.CentimetersToPoints(0.5) '页眉

.FooterMargin = Application.CentimetersToPoints(0.5) '页脚

.Zoom = 100

End With  

End Sub
Sub yya()
For Each sh In ThisWorkbook.Sheets

With sh
With .PageSetup
.TopMargin = Application.CentimetersToPoints(2.5) '顶边距

    .CenterHorizontally = True '水平居中  
    .CenterVertically = True '垂直居中  
    .Orientation = xlLandscape '横向打印

    End With  

End With
Next
End Sub
Public Sub shanchu()
Application.DisplayAlerts = False '关闭警告信息显示
Dim i As Integer

For i = Sheets.Count To 1 Step -1  
    Debug.Print Sheets(i).Name  
    If Sheets(i).Name <> "Sheet1" Then  
        Sheets(i).Delete  
    End If  
Next  

End Sub
Sub pd()
n = Worksheets.Count
Dim i As Integer
Dim xx As Integer
Dim yy As Integer
Dim mm As Integer
Rem xx为每个考场的人数
Rem yy为当前专业标记
Rem mm为当前专业考生人数
Rem shu为当前专业考号张数
Rem shuu为当前专业考场数量
xx = 45
yy = 2002
mm = 889
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 / xx) = mm / xx Then
shu = mm / xx
ElseIf Int(mm / xx) <> mm / xx Then
shu = Int(mm / xx) + 1
End If

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

Next
If yy = 2007 Then
mc = "裴竞考场"
ElseIf yy = 2001 Then
mc = "机电考场"
ElseIf yy = 2002 Then
mc = "计算机考场"
ElseIf yy = 2003 Then
mc = "会计考场"
ElseIf yy = 2004 Then
mc = "学前考场"
ElseIf yy = 2005 Then
mc = "电商考场"
ElseIf yy = 2006 Then
mc = "汽修考场"
ElseIf yy = 2008 Then
mc = "航空考场"
ElseIf yy = 2009 Then
mc = "轨道考场"
ElseIf yy = 2010 Then
mc = "电力考场"
End If

bz = 0
For i = 1 To shuu
Worksheets(i).Activate

ab = pda((i * xx - xx) + 1)

ab1 = pda((i * xx))
If ab1 >= mm Then
If i = shuu Then
ab1 = mm
End If
End If

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
If i = shuu And i = 1 Then

Range("a" & 1) = mc

Else
Range("a" & 1) = mc & i
End If
abb = ab
Range("a" & 2) = "(" & yy & ab & " - " & yy & ab1 & ")"

Next
For Each sh In ThisWorkbook.Sheets

With sh
With .PageSetup
.TopMargin = Application.CentimetersToPoints(2.5) '顶边距

    .CenterHorizontally = True '水平居中  
    .CenterVertically = True '垂直居中  
    .Orientation = xlLandscape '横向打印

    End With  

End With
Next
End Sub
Sub pdda()
n = Worksheets.Count
Dim i As Integer
Dim xx As Integer
Dim yy As Integer
Dim mm As Integer
Rem xx为每个考场的人数
Rem yy为当前专业标记
Rem mm为当前专业考生人数
Rem shu为当前专业考号张数
Rem shuu为当前专业考场数量
xx = 45
yy = 2002
mm = 889
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 / xx) = mm / xx Then
shu = mm / xx
ElseIf Int(mm / xx) <> mm / xx Then
shu = Int(mm / xx) + 1
End If

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

Next
If yy = 2007 Then
mc = "裴竞考场"
ElseIf yy = 2001 Then
mc = "机电考场"
ElseIf yy = 2002 Then
mc = "计算机考场"
ElseIf yy = 2003 Then
mc = "会计考场"
ElseIf yy = 2004 Then
mc = "学前考场"
ElseIf yy = 2005 Then
mc = "电商考场"
ElseIf yy = 2006 Then
mc = "汽修考场"
ElseIf yy = 2008 Then
mc = "航空考场"
ElseIf yy = 2009 Then
mc = "轨道考场"
ElseIf yy = 2010 Then
mc = "电力考场"
End If

bz = 0
For i = 2 To shuu
Worksheets(i).Activate

ab = pda((i * xx - xx) + 1)

ab1 = pda((i * xx))
If ab1 >= mm Then
If i = shuu Then
ab1 = mm
End If
End If

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
If i = shuu And i = 1 Then

Range("a" & 1) = mc

Else
Range("a" & 1) = mc & i
End If
abb = ab
Range("a" & 2) = "(" & yy & ab & " - " & yy & ab1 & ")"
With ActiveSheet.PageSetup
.TopMargin = Application.CentimetersToPoints(2.5) '顶边距
.CenterHorizontally = True '水平居中
.CenterVertically = True '垂直居中
.Orientation = xlLandscape '横向打印

End With
Next

End Sub

手机扫一扫

移动阅读更方便

阿里云服务器
腾讯云服务器
七牛云服务器

你可能感兴趣的文章