Problem: You've been given 20 minutes to update 3 tabs of a 25 Tab *MONSTER* Spreadsheet, and REPORT your updates .... Some are Landscape and some are Portrait. Most are 5+ pages long.
How to make page number, sheet name and file name show in header and footer for your meeting in 20 minutes?
Sub Write_Header_Footer_from_Many_Tabbed_Workbook()
Dim qystring, howmany, menudefault, sht
'THIS IS FOR A XLS OF MANY TABS - sets the header, footer, and margins of each tab
If Not ActiveWorkbook.Saved Then
qystring = "nonemptystring"
howmany = Sheets.Count
Do
menudefault = "OK to wait " & howmany * 10 & " seconds " ' Set default.
qystring = InputBox("Wait 10 seconds each while header/footers written for " & howmany & " tabs?" _
& vbCrLf & vbCrLf & "Enter Yes / No (or press 'Escape Key' to Skip)", "Enter Yes / No (or press 'Escape Key' to Skip)", menudefault)
If qystring > "" Then qystring = UCase(Left(qystring, 1))
'qystring = MsgBox(menudefault & " for " & howmany & " tabs?", vbYesNoCancel, "Write Tab Names to Header and Footer")
Loop Until ((qystring = "N") Or (qystring = "Y") Or (qystring = "O") Or (qystring = ""))
End If 'if not saved
If UCase(Left(qystring, 1)) = "N" Then
Exit Sub
' If qystring <> vbYes Then Exit Sub 'this line is if using msgbox alternative to inputbox above
Else
For Each sht In Sheets
With sht.PageSetup
.CenterHeader = "&A"
.RightFooter = "Page &P of &N"
.CenterFooter = "&08" & "&F" 'to show full (network) path use ' Me.Path & "/" & vbCrLf & "&F"
.LeftFooter = "&D &T"
.FitToPagesWide = 1
.FitToPagesTall = 999
.PrintTitleRows = "$1:$1"
If (.Orientation = xlLandscape) Then
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.65)
.BottomMargin = Application.InchesToPoints(0.65)
.HeaderMargin = Application.InchesToPoints(0.2)
.FooterMargin = Application.InchesToPoints(0.2)
Else
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0.5)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.2)
.FooterMargin = Application.InchesToPoints(0.2)
End If
End With
Next sht
End If ' vbyes
End Sub
'--------------
Thanks, great article.