除非空白，否则Excel页眉/页脚不会通过VBA更改

Question

Disclaimer: It's been a few years since I worked (a lot) with VBA, so this might be an issue caused by confusing myself with what is essentially a very different language from what I usually deal with.

So; I've got a workbook (Excel 2010) with multiple sheets (20+), most of whom are multi-page. To make things easier when printing everything, I want to add some sheet-specific headers with amongst others the name of the sheet, number of pages and so on.

I've written a tiny function that should (in theory) do this for me by iterating over all the sheets setting the header. However, for some reason it only works if the header is empty; if it already has a value it refuses to overwrite for some unknown reason.

Dim sheetIndex, numsheets As Integer
sheetIndex = 1
numsheets = Sheets.Count

' Loop through each sheet, but don't set any of them to active
While sheetIndex <= numsheets
    Dim sheetname, role, labeltext As String
    sheetname = Sheets(sheetIndex).name
    role = GetRole(mode) 
    labeltext = "Some text - " & sheetname & " - " & role

    With Sheets(sheetIndex).PageSetup
        .LeftHeader = labeltext
        .CenterHeader = ""
        .RightHeader = "Page &[Page] / &[Pages]"
        .LeftFooter = "&[Date] - &[Time]"
        .CenterFooter = ""
        .RightFooter = "Page &P / &N"
    End With

    sheetIndex = sheetIndex + 1
Wend

Answer 1

I found a solution that seems to work for replacing text. For whatever reason, in the macro, you need to include the header/footer format character codes in order for it to work properly.

This code worked to replace existing header text with new information:

Sub test()
    Dim sht As Worksheet
    Set sht = Worksheets(1)
    sht.PageSetup.LeftHeader = "&L left text"
    sht.PageSetup.CenterHeader = "&C center Text"
    sht.PageSetup.RightHeader = "&R right text"
End Sub

Without the &L , &C , and &R codes before the text, I could not get it to work.

Some interesting behavior I found is that if you use the following code:

.CenterHeader = "&L some text"

it will actually put the some text in the LeftHeader position. This led me to believe that the formatting codes were very important.

Answer 2

The line Application.PrintCommunication = False (which is added by the macro recorder) before doing PageSetup screws up the formating via VBA.

If your code has got this line in it, try removing it. That solved my problem with setting the header and footer via VBA.

Answer 3

I've read StackOverflow for years and this is the first time I've actually been able to post a solution ... hope it helps someone!! Also, you need to remember, I am a CPA not a programmer ;-)

I am reading some values from the ActiveSheet to populate the header. The application is a tax election that will be sent with a tax return so it must have the taxpayer's name and social security number at the top.

Sub PrintElection()
' Print preview the MTM Election
    If Range("Tax_Year").Value = Range("First_MTM_year").Value Then
        ActiveSheet.PageSetup.LeftHeader = Format(Worksheets("Election").Range("Taxpayer_Name").Value)
        ActiveSheet.PageSetup.RightHeader = Format(Worksheets("Election").Range("Taxpayer_SSN").Value)

        ActiveWindow.SelectedSheets.PrintPreview

    Else

        MsgBox "The 'Effective For Tax Year' date must EQUAL the 'First MTM year' date", vbOKOnly, "Check Years"
        Sheets("Roadmap").Select
        Range("First_MTM_year").Select
   End If

End Sub

It checks to see if the Mark-to-Market election year is the same as the election form then formats the election page.

Answer 4

I split the sheet print setup into 2 loops. First loop with Application.PrintCommunication = False I run the non-header/footer setup. I then set Application.PrintCommunication = True and run the header/footer setup in a second loop. Appears to run faster than in XL2003, and applies the header/footer correctly. Until MS fixes this bug, that works fine for me.