VBA:考场场标打印

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