多个工作表的打印格式设定，VBA执行时间很长。求优化

aronic

代码如下图，
    For Each sht2 In Worksheets
      
        With sht2
        .Rows("1:1").EntireRow.Hidden = True
        .[A1].CurrentRegion.Borders.LineStyle = 1
        .Cells.Interior.ThemeColor = xlThemeColorDark1
        .Columns("B:B").ColumnWidth = 7.45
        .Columns("C:C").ColumnWidth = 2.56
        .Columns("D:D").ColumnWidth = 16
        .Columns("E:E").ColumnWidth = 7.56
        .Columns("F:F").ColumnWidth = 37
        .Columns("G:G").ColumnWidth = 4
        .Columns("H:H").ColumnWidth = 52.89
        .Columns("I:I").ColumnWidth = 18
        .Range("C2:D2").Merge
        .Range("C2") = .Name
        .Columns("H:I").WrapText = True
        .Rows(1).RowHeight = 14.4
        .Rows(2).RowHeight = 25.8
        .Rows(3).RowHeight = 14.4
        .Rows(4).RowHeight = 14.4
        .Range("A4:I4").Interior.ColorIndex = 43
        .Range("D3,F2").HorizontalAlignment = Excel.xlRight
        .Columns("A:A").EntireColumn.Hidden = True
        .Rows("1:1").EntireRow.Hidden = True
        .Columns("F").WrapText = True
        .Columns("D").WrapText = True
        .Range("B2：C2").Interior.ColorIndex = 43
        .Range("B2:I3").Borders.LineStyle = 0
        .Range("B4").CurrentRegion.Font.Name = "宋体"
        .Range("B4").CurrentRegion.Font.Size = 10
        .Rows(1).Font.Size = 2
        .Columns("B:I").EntireColumn.AutoFit
        With .PageSetup
            .PrintArea = sht2.Range("B2").CurrentRegion.Address
            .LeftMargin = Application.InchesToPoints(0.3)   
            .RightMargin = Application.InchesToPoints(0.3)      
            .TopMargin = Application.InchesToPoints(0.5)        
            .BottomMargin = Application.InchesToPoints(0.5)     
            .HeaderMargin = Application.InchesToPoints(0.3)     
            .FooterMargin = Application.InchesToPoints(0.3)     
            .CenterFooter = "第 &P 页，共 &N 页"
            .CenterHorizontally = True
'            .CenterVertically = False
            .Orientation = xlLandscape                           '页面方向：纵向(T) xlPortrait/ 横向 (L)xlLandscape
'            .PaperSize = xlPaperA4                              '页面纸张大小(Z)：A4
'            .FirstPageNumber = xlAutomatic                      '
'            .BlackAndWhite = False                              
            .Zoom = 90                                       
         End With
        End With
       Next

f8b1987

其中行高列宽都是可以批量一次性同步设置的，无需循环执行，这个可以单独操作。
还有关闭刷新，等代码结束时再开启

zldccmx

不使用循环，删除原代码中以下红色字体语句,用左边的语句替代

      

Sheets.Select'For Each sht2 In Worksheets
          With ActiveSheet 'With sht2



               '删除'      next          

草率了，没有测试..........

aronic

zldccmx 发表于 2021-8-7 21:07
不使用循环，删除原代码中以下红色字体语句,用左边的语句替代

       Sheets.Select'For Each sht2 In W ...

试过了，不能一次性格式化所有的sheet

zldccmx

1. '        .Columns("B:B").ColumnWidth = 7.45
   
2. '        .Columns("C:C").ColumnWidth = 2.56
   
3. '        .Columns("D:D").ColumnWidth = 16
   
4. '        .Columns("E:E").ColumnWidth = 7.56
   
5. '        .Columns("F:F").ColumnWidth = 37
   
6. '        .Columns("G:G").ColumnWidth = 4
   
7. '        .Columns("H:H").ColumnWidth = 52.89
   
8. '        .Columns("I:I").ColumnWidth = 18
   
9. '以上语句由以下一条替代
   
10.         .[B1:H1].ColumnWidth = Array(7.45, 2.56, 16, 7.56, 37, 4, 52.89, 18)

复制代码

zldccmx

1. '        .Rows(1).RowHeight = 14.4
   
2. '        .Rows(2).RowHeight = 25.8
   
3. '        .Rows(3).RowHeight = 14.4
   
4. '        .Rows(4).RowHeight = 14.4
   
5. '以下2句替代上面4句
   
6.         .Range("1:1,3:4").RowHeight = 14.4
   
7.         .Rows(2).RowHeight = 25.8

复制代码

zldccmx

1. '        .Columns("F").WrapText = True
   
2. '        .Columns("D").WrapText = True
   
3. '        .Columns("H:I").WrapText = True
   
4. '        以上3句由以下一句代替
   
5.         .Range("H:I,D:D,F:F").WrapText = True

复制代码