LinkBack URL
About LinkBacks
Hello all,
The code at issue is supposed to pull data from cells located on what I call the HeaderPage worksheet and populate the header/footer. It should run on all subsequent worksheets where the header and footer on those sheets is also populated with the same cell data from the HeaderPage worksheet.
The below code is two parts
PART 1 -This is found in ThisWorkbook - It controls the module 1 code to run BeforePrint and BeforeSave
CODE:
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Const c_intMaxHdrLen As Integer = 232
Dim wkSht As Worksheet
If Range("HdrLen") > c_intMaxHdrLen Then
MsgBox "Your Header exceeds 232 characters. Please go back to the header page and reduce the # of Characters"
Cancel = True
Exit Sub
End If
Application.ScreenUpdating = False
For Each wkSht In ThisWorkbook.Worksheets
SetHeader wkSht
Next wkSht
Application.ScreenUpdating = True
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Const c_intMaxHdrLen As Integer = 232
Dim wkSht As Worksheet
If Range("HdrLen") > c_intMaxHdrLen Then
MsgBox "Your Header exceeds 232 characters. Please go back to the header page and reduce the # of Characters"
Cancel = True
Exit Sub
End If
Application.ScreenUpdating = False
For Each wkSht In ThisWorkbook.Worksheets
SetHeader wkSht
Next wkSht
Application.ScreenUpdating = True
End Sub
*************************************************************
PART 2 This code is found in Module 1 and it is what gets run when the Before Print and BeforeSave events are activated.
Please note that the PART 2 is ran on all sheets when subbed.
CODE:
Dim lStr As String
Dim rStr As String
Dim dStr As String
Dim eStr As String
With Worksheets("HeaderPage")
Application.ScreenUpdating = False
lStr = "&8" & Range("K2") & vbCr & .Range("K3") & vbCr & .Range("K4") & vbCr & .Range("K5")
rStr = "&8" & Range("M2") & vbCr & .Range("M3") & vbCr & .Range("M4") & vbCr & .Range("M5") & vbCr & .Range("M6")
dStr = "&8" & Range("M11")
eStr = "&6" & Range("W1") & vbCr & .Range("W2") & vbCr & .Range("W3") & vbCr & .Range("W4")
End With
With sh.PageSetup
.LeftHeader = lStr
.CenterHeader = dStr
.RightHeader = rStr
.CenterFooter = eStr
End With
With ActiveSheet.PageSetup
.TopMargin = Application.InchesToPoints(1.24)
.BottomMargin = Application.InchesToPoints(1)
Sheets("Instructions").Visible = False
End With
End Sub
*********************************************************
THE ISSUE:
When I sub this to run either by trying to print or by saving, the HeaderPage sheet is the only one where the header and footer properly update. All subsequent sheets drop the center header and the first line of the center footer.
It would appear that excel is ignoring part of the code. I can't figure out why. Interestingly enough the dStr and eStr parts of the above code are cloe to eachohter with in the code and it seems to be ignoring all of the dStr and the first range in the eStr.
Can you tell me why? This was working fine at one point.
Thanks
Dan
Register To Reply
Bookmarks