This should fry your squash, it did mine

[retseort]

Hello all,

The code at issue is supposed to pull data from cells located on what
call the HeaderPage worksheet and populate the header/footer. It shoul
run on all subsequent worksheets where the header and footer on thos
sheets is also populated with the same cell data from the HeaderPag
worksheet.

The below code is two parts

PART 1 -This is found in ThisWorkbook - It controls the module 1 cod
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 t
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 A
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 t
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 th
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, th
HeaderPage sheet is the only one where the header and footer properl
update. All subsequent sheets drop the center header and the first lin
of the center footer.

It would appear that excel is ignoring part of the code. I can't figur
out why. Interestingly enough the dStr and eStr parts of the above cod
are cloe to eachohter with in the code and it seems to be ignoring al
of the dStr and the first range in the eStr.

Can you tell me why? This was working fine at one point.

Thanks
Da

 

[Tom Ogilvy]

Some of your "Range" items do not have a period preceding them, so they
don't refer to Worksheets("header")


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

Should be

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