更新页眉会破坏我的页面方向和缩放。

Question

所以昨天我烧掉了整整一天，在一个不同的过程中，根据一个单元格值，对图像进行了侧跟踪。有趣的是，这一切都是从我开始写一点VBA，以便在打印或保存之前自动更新页眉和页脚信息。

情况

我目前在工作簿上有12个工作表。Sheet1(页眉和页脚)包含要进入各个页眉/页脚位置的所有信息。

第2-7页是作为一个组打印出来的页面，其中包含页眉和页脚。

第2-6页是肖像书页，每张纸上有多页(由于版面的原因，我不能在某些单张上强迫1页宽)。

单张7是风景书信页。

如果我在编写代码之前以pdf格式打印/save，然后单独更改每一页--一切都很好--所有页面都打印在各自的页面布局/设置中。

当我在ThisWorkbook中实现VBA代码之前打印或预告时，事情并不顺利。取决于我尝试过的VBA代码的哪一种变体，任何一张7都将采用纵向方向和缩放方式，与其他页相同，或者所有工作表都是横向的，并且具有表7的缩放性。

目标

使用适当的页眉/页脚信息更新工作表2至7，同时维护它们原来指定的页面设置。那样的话，当我打印的时候，2-6张都是肖像，第7张全是书信纸上的风景。

我试过的

我录制了一个宏来获得基本结构。最初，它有所有的纸张在一个地区，并修改他们。我认为所有的页面都是一样的，因为它们都是同时被选择的，所以我想我应该试着一次修改一张纸，而不是一次选择所有的页面。这导致只打印一个工作表，因此我不得不添加重新选择所有工作表作为最后一行代码。这是我目前拥有的VBA代码：

Private Sub WorkbookBeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim ws As Worksheet

    For Each ws In Worksheets
    If ws.Name <> "HEADER AND FOOTER" And InStr(1, Left(ws.Name, 5), "Table", vbTextCompare) = 0 Then
        Application.PrintCommunication = False
        With ActiveSheet.PageSetup
            .CenterHeader = Sheets(1).Range("B1").Value & Chr(10) & "Load Evaluation"
            .RightHeader = _
            "Calculated by: " & Sheets(1).Range("B3").Value & "  Date: " & Sheets(1).Range("B4").Value & Chr(10) & "Checked By:  " & Sheets(1).Range("B5").Value & "  Date: " & Sheets(1).Range("B6").Value
            .LeftFooter = "Project Number: " & Sheets(1).Range("B2").Value
            .CenterFooter = "Page &P/&N"
            .RightFooter = "Print Date:  " & Sheets(1).Range("B7").Value
        End With
    End If
    Next ws
    Sheets(Array("General", "Loads", "Capacity", "Analysis", "POSTING", "SUMMARY")).Select
    Sheets("General").Activate
 End Sub

我在想，也许我为每个人实现的方式有问题，因为这不是我所熟悉的表单。我最初是在考虑使用For x = 2 to ws.count - UDF_worksheet_count_names_starting_with_tables来遍历表单。我想我应该先在这里检查一下，看看是否有更好的方法来解决这个问题。

Answer 1

首先，感谢D.K.建议将activesheet.page设置改为ws.pagesetup。然而，这并没有解决问题，但更有意义。然后我无意中发现了这个线程：Excel headers/footers won't change via VBA unless blank。我在想这条线是什么

 Application.PrintCommunication = False 

确实是这样。当我评论这一行时，最后一个工作表的布局不再被更新/更改以与其他页面相匹配，并且事情正在按预期工作。

最后的代码是这样的：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim ws As Worksheet

    For Each ws In Worksheets
        If ws.Name <> "HEADER AND FOOTER" And InStr(1, Left(ws.Name, 5), "Table", vbTextCompare) = 0 Then
            With ws.PageSetup
                .CenterHeader = Sheets(1).Range("B1").Value & Chr(10) & "Load Evaluation"
                .RightHeader = _
                "Calculated by: " & Sheets(1).Range("B3").Value & "  Date: " & Sheets(1).Range("B4").Value & Chr(10) & "Checked By:  " & Sheets(1).Range("B5").Value & "  Date: " & Sheets(1).Range("B6").Value
                .LeftFooter = "Project Number: " & Sheets(1).Range("B2").Value
                .CenterFooter = "Page &P/&N"
                .RightFooter = "Print Date:  " & Sheets(1).Range("B7").Value
            End With
        End If
    Next ws
 End Sub