VBA遍历工作表应用格式时最后一张表部分设置不生效问题

安全阿岳

2026-7-24

VBA宏最后一张工作表PageSetup格式未生效问题

编写的VBA宏可遍历目录下所有文件，为每个文件的工作表应用格式设置：第一张名为"TOC"的工作表格式正常，其余1-3张数据工作表中，仅最后一张的部分PageSetup设置（如页面方向xlLandscape、边距等）未生效，其余数据工作表均正常。

原代码

Sub LoopThroughFiles()

Application.ScreenUpdating = False

Dim ws As Worksheet
           
For Each ws In Sheets
    ws.Activate
'''apply format to first sheet'''   
    If ws.Name = "TOC" Then
        With ws.PageSetup
            .LeftFooter = "&""-,Bold"" Confidential"
            .CenterFooter = "&D"
            .RightFooter = "Page &P of &N"
            .LeftMargin = Application.InchesToPoints(0)
            .RightMargin = Application.InchesToPoints(0)
            .TopMargin = Application.InchesToPoints(0.5)
            .BottomMargin = Application.InchesToPoints(0.5)
            .HeaderMargin = Application.InchesToPoints(0)
            .FooterMargin = Application.InchesToPoints(0.3)
            .PrintHeadings = False
            .PrintGridlines = False
            .PrintComments = xlPrintNoComments
            .PrintQuality = 600
            .CenterHorizontally = True
            .CenterVertically = False
            .Orientation = xlLandscape
            .Draft = False
            .PaperSize = xlPaperLetter
            .FirstPageNumber = xlAutomatic
            .Order = xlDownThenOver
            .BlackAndWhite = False
            .Zoom = 100
            .FitToPagesWide = 1
            .PrintErrors = xlPrintErrorsDisplayed
            .OddAndEvenPagesHeaderFooter = False
            .DifferentFirstPageHeaderFooter = False
            .ScaleWithDocHeaderFooter = True
            .AlignMarginsHeaderFooter = True
        End With
    Else
'''apply format to other sheets'''
        Application.PrintCommunication = False
        Application.PrintCommunication = True
        ws.PageSetup.PrintArea = ""
        Application.PrintCommunication = False
            With ws.PageSetup
                .PrintTitleRows = "$1:$2"
                .PrintTitleColumns = ""
                .LeftFooter = "&""-,Bold"" Confidential"
                .CenterFooter = "&D"
                .RightFooter = "Page &P of &N"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''this section does not get applied to the last worksheet''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                .LeftMargin = Application.InchesToPoints(0)
                .RightMargin = Application.InchesToPoints(0)
                .TopMargin = Application.InchesToPoints(0.5)
                .BottomMargin = Application.InchesToPoints(0.5)
                .HeaderMargin = Application.InchesToPoints(0.3)
                .FooterMargin = Application.InchesToPoints(0.3)
                .PrintHeadings = False
                .PrintGridlines = False
                .PrintComments = xlPrintNoComments
                .PrintQuality = 600
                .CenterHorizontally = True
                .CenterVertically = True
                .Orientation = xlLandscape
                .Draft = False
                .PaperSize = xlPaperLetter
                .FirstPageNumber = xlAutomatic
                .Order = xlDownThenOver
                .BlackAndWhite = False
                .Zoom = 100
                .FitToPagesWide = 1
                .FitToPagesTall = 0
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                .PrintErrors = xlPrintErrorsDisplayed
                .OddAndEvenPagesHeaderFooter = False
                .DifferentFirstPageHeaderFooter = False
                .ScaleWithDocHeaderFooter = True
                .AlignMarginsHeaderFooter = True
                .EvenPage.LeftHeader.Text = ""
                .EvenPage.CenterHeader.Text = ""
                .EvenPage.RightHeader.Text = ""
                .EvenPage.LeftFooter.Text = ""
                .EvenPage.CenterFooter.Text = ""
                .EvenPage.RightFooter.Text = ""
                .FirstPage.LeftHeader.Text = ""
                .FirstPage.CenterHeader.Text = ""
                .FirstPage.RightHeader.Text = ""
                .FirstPage.LeftFooter.Text = ""
                .FirstPage.CenterFooter.Text = ""
                .FirstPage.RightFooter.Text = ""
            End With
    End If
Next ws
    
ActiveWorkbook.Close SaveChanges:=True
Application.ScreenUpdating = True

End Sub

问题根源及修复方案

PrintCommunication使用错误：原代码在Else块中先关闭再立即开启PrintCommunication，随后又关闭，导致部分设置未被批量提交，最后一张工作表的设置容易丢失。应将所有PageSetup操作统一放在Application.PrintCommunication = False和True之间。
不必要的Worksheet.Activate：激活工作表并非必须，直接通过ws对象操作更稳定，避免因激活状态异常导致的设置失效。
Zoom与FitToPagesWide冲突：当设置FitToPagesWide = 1时，Excel会自动将Zoom设为False，手动设置Zoom = 100会覆盖FitToPages的设置逻辑，导致页面格式异常。
最后工作表设置未强制刷新：部分情况下，最后一张工作表的PageSetup设置可能因缓存未更新而不生效，需强制触发刷新。

修改后的代码

Sub LoopThroughFiles()
    Application.ScreenUpdating = False
    Application.PrintCommunication = False ' 全局关闭打印通信，提升效率并避免设置丢失
    
    Dim ws As Worksheet
           
    For Each ws In ThisWorkbook.Sheets ' 使用ThisWorkbook明确指向当前工作簿
        If ws.Name = "TOC" Then
            With ws.PageSetup
                .LeftFooter = "&""-,Bold"" Confidential"
                .CenterFooter = "&D"
                .RightFooter = "Page &P of &N"
                .LeftMargin = Application.InchesToPoints(0)
                .RightMargin = Application.InchesToPoints(0)
                .TopMargin = Application.InchesToPoints(0.5)
                .BottomMargin = Application.InchesToPoints(0.5)
                .HeaderMargin = Application.InchesToPoints(0)
                .FooterMargin = Application.InchesToPoints(0.3)
                .PrintHeadings = False
                .PrintGridlines = False
                .PrintComments = xlPrintNoComments
                .PrintQuality = 600
                .CenterHorizontally = True
                .CenterVertically = False
                .Orientation = xlLandscape
                .Draft = False
                .PaperSize = xlPaperLetter
                .FirstPageNumber = xlAutomatic
                .Order = xlDownThenOver
                .BlackAndWhite = False
                .FitToPagesWide = 1 ' 去掉Zoom设置，避免冲突
                .PrintErrors = xlPrintErrorsDisplayed
                .OddAndEvenPagesHeaderFooter = False
                .DifferentFirstPageHeaderFooter = False
                .ScaleWithDocHeaderFooter = True
                .AlignMarginsHeaderFooter = True
            End With
        Else
            ws.PageSetup.PrintArea = ""
            With ws.PageSetup
                .PrintTitleRows = "$1:$2"
                .PrintTitleColumns = ""
                .LeftFooter = "&""-,Bold"" Confidential"
                .CenterFooter = "&D"
                .RightFooter = "Page &P of &N"
                .LeftMargin = Application.InchesToPoints(0)
                .RightMargin = Application.InchesToPoints(0)
                .TopMargin = Application.InchesToPoints(0.5)
                .BottomMargin = Application.InchesToPoints(0.5)
                .HeaderMargin = Application.InchesToPoints(0.3)
                .FooterMargin = Application.InchesToPoints(0.3)
                .PrintHeadings = False
                .PrintGridlines = False
                .PrintComments = xlPrintNoComments
                .PrintQuality = 600
                .CenterHorizontally = True
                .CenterVertically = True
                .Orientation = xlLandscape
                .Draft = False
                .PaperSize = xlPaperLetter
                .FirstPageNumber = xlAutomatic
                .Order = xlDownThenOver
                .BlackAndWhite = False
                .FitToPagesWide = 1 ' 去掉Zoom设置
                .FitToPagesTall = 0
                .PrintErrors = xlPrintErrorsDisplayed
                .OddAndEvenPagesHeaderFooter = False
                .DifferentFirstPageHeaderFooter = False
                .ScaleWithDocHeaderFooter = True
                .AlignMarginsHeaderFooter = True
                .EvenPage.LeftHeader.Text = ""
                .EvenPage.CenterHeader.Text = ""
                .EvenPage.RightHeader.Text = ""
                .EvenPage.LeftFooter.Text = ""
                .EvenPage.CenterFooter.Text = ""
                .EvenPage.RightFooter.Text = ""
                .FirstPage.LeftHeader.Text = ""
                .FirstPage.CenterHeader.Text = ""
                .FirstPage.RightHeader.Text = ""
                .FirstPage.LeftFooter.Text = ""
                .FirstPage.CenterFooter.Text = ""
                .FirstPage.RightFooter.Text = ""
            End With
        End If
    Next ws
    
    Application.PrintCommunication = True ' 开启打印通信，提交所有设置
    ThisWorkbook.Close SaveChanges:=True ' 用ThisWorkbook替代ActiveWorkbook，更可靠
    Application.ScreenUpdating = True
End Sub

额外验证步骤

如果修改后仍有问题，可在Next ws前添加以下代码强制刷新最后一张工作表的PageSetup：

' 强制刷新最后一张工作表的页面设置
With Sheets(Sheets.Count).PageSetup
    .Orientation = .Orientation ' 重新赋值触发刷新
End With

内容的提问来源于stack exchange，提问作者JYurkovich

VBA遍历工作表应用格式时最后一张表部分设置不生效问题

原代码 #

问题根源及修复方案 #

修改后的代码 #

额外验证步骤 #

原代码

问题根源及修复方案

修改后的代码

额外验证步骤