[已解决]批量设置页面格式

dyzx

grf1973 发表于 2016-12-21 13:02
自己录个宏，改下。

grf1973老师：如下代码可以吗？
Sub 页面设置3()
    Dim sh As Worksheet
    For Each sh In Worksheets
         If sh.Name Like "*班" Then x = x & "," & sh.Name
    Next
    x = Mid(x, 2)
    If InStr(x, ",") > 0 Then Sheets(Split(x, ",")).Select Else If Len(x) > 0 Then Sheets(x).Select
With sh.PageSetup
.PageSetup.Orientation = xlLandscape  '纸张横向'
.PageSetup.Orientation = xlPortrait  '纸张纵向'
.PageSetup.PaperSize = xlPaperA4
.PageSetup.LeftMargin = Application.CentimetersToPoints(0.1)
.PageSetup.RightMargin = Application.CentimetersToPoints(0.1)
.PageSetup.TopMargin = Application.CentimetersToPoints(1)
.PageSetup.BottomMargin = Application.CentimetersToPoints(1)
.PageSetup.HeaderMargin = Application.CentimetersToPoints(1)
.PageSetup.FooterMargin = Application.CentimetersToPoints(0.5)
.PageSetup.BlackAndWhite = True  '单色打印
.PageSetup.PrintTitleRows = "$1:$2" '设置“顶端标题行”
.PageSetup.CenterHorizontally = True  '水平居中
.PageSetup.LeftFooter = "第 &P 页，共 &N 页"

End With
End Sub

grf1973

1. Sub 页面设置3()
   
2.     Dim sh As Worksheet
   
3.     For Each sh In Worksheets
   
4.          If sh.Name Like "*班" Then
   
5.             With sh.PageSetup
   
6.                 .Orientation = xlLandscape  '纸张横向'
   
7.                 .Orientation = xlPortrait  '纸张纵向'
   
8.                 .PaperSize = xlPaperA4
   
9.                 .LeftMargin = Application.CentimetersToPoints(0.1)
   
10.                 .RightMargin = Application.CentimetersToPoints(0.1)
    
11.                 .TopMargin = Application.CentimetersToPoints(1)
    
12.                 .BottomMargin = Application.CentimetersToPoints(1)
    
13.                 .HeaderMargin = Application.CentimetersToPoints(1)
    
14.                 .FooterMargin = Application.CentimetersToPoints(0.5)
    
15.                 .BlackAndWhite = True  '单色打印
    
16.                 .PrintTitleRows = "$1:$2" '设置“顶端标题行”
    
17.                 .CenterHorizontally = True  '水平居中
    
18.                 .LeftFooter = "第 &P 页，共 &N 页"
    
19.             End With
    
20.         End If
    
21.     Next
    
22. End Sub

复制代码

dyzx

grf1973 发表于 2016-12-21 15:36

grf1973老师：运行速度很慢，能否简化一点？多谢指教。

grf1973

1. Sub 页面设置3()
   
2.     'tt = Timer
   
3.     Dim sh As Worksheet
   
4.     Application.PrintCommunication = False
   
5.     For Each sh In Worksheets
   
6.          If sh.Name Like "*班" Then x = x & "," & sh.Name
   
7.     Next
   
8.     x = Mid(x, 2)
   
9.     If InStr(x, ",") > 0 Then Sheets(Split(x, ",")).Select Else If Len(x) > 0 Then Sheets(x).Select
   
10.     Sheets(Split(x, ",")(0)).Activate
    
11.     With ActiveSheet.PageSetup
    
12.         .Orientation = xlLandscape  '纸张横向'
    
13.         .Orientation = xlPortrait  '纸张纵向'
    
14.         .PaperSize = xlPaperA4
    
15.         .LeftMargin = Application.CentimetersToPoints(0.1)
    
16.         .RightMargin = Application.CentimetersToPoints(0.1)
    
17.         .TopMargin = Application.CentimetersToPoints(1)
    
18.         .BottomMargin = Application.CentimetersToPoints(1)
    
19.         .HeaderMargin = Application.CentimetersToPoints(1)
    
20.         .FooterMargin = Application.CentimetersToPoints(0.5)
    
21.         .BlackAndWhite = True  '单色打印
    
22.         .PrintTitleRows = "$1:$2" '设置“顶端标题行”
    
23.         .CenterHorizontally = True  '水平居中
    
24.         .LeftFooter = "第 &P 页，共 &N 页"
    
25.     End With
    
26.     Application.PrintCommunication = True
    
27.     'MsgBox Timer - tt
    
28. End Sub
    

复制代码

dyzx

grf1973老师：多谢老师的耐心指教，多谢。

雨玥

grf1973 发表于 2016-12-21 16:02

谢谢老师。我在运行时这句Sub 页面设置3()    Application.PrintCommunication = False不能运行了。请教一下，是要设置什么后才能运行吗。[img=0,1]file:///C:\Documents and Settings\Administrator\Application Data\Tencent\Users\1042271867\QQ\WinTemp\RichOle\[YH[[QJC(7CIMNJQ2M{O}[J.png[/img]