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.