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