attn: Tom Ogilvy re: cell data in header

[retseort]

Tom,

I used your script you supplied with success. Although I moved it to
the Left Header. Now I need to do the same and populate the right
header as well. Can you show me how you would extend the script you
wrote to perform this in the left headr and then continue placing info
in the right header? Center Header would be blank in this case.

When done I should have the left header showing the Document Title and
Revison date stacked upon one another and on the right I should have
the author and approval date.

Thanks
Dan

Original message

Re: Header formatting problem

--------------------------------------------------------------------------------

As I suggested, I recorded a two line center header set up as I wanted
it.
I then modified the code to include values from Sheet1!B2 and
Sheet1!B4
and this is what I modified it to:

Sub SetHeader(sh as Worksheet)
sStr = "&""Arial,Bold""&12Cell input is " & _
Range("Sheet1!B2").Text & _
" for line 1&""Arial,Regular""&10" & Chr(10) & _
"&""Arial,Italic""&8Cell input is" & _
Range("Sheet1!B4").Text & " for line 2"
With Sh.PageSetup
..CenterHeader = sStr
End With
End Sub

Put the above in a general module.
then you can set up your code as

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim wkSht As Worksheet

For Each wkSht In ThisWorkbook.Worksheets

SetHeader wkSht

Next wkSht
End Sub

 

[Tom Ogilvy]

Sub SetHeader(sh As Worksheet)
Dim sStr As String
Dim sStr1 As String
sStr = "&""Arial,Bold""&12Title: " & _
Range("Sheet1!B2").Text & _
Chr(10) & _
"&""Arial,Italic""&8Revision Date: " & _
Range("Sheet1!B4").Text

sStr1 = "&""Arial,Bold""&12Author: " & _
Range("Sheet1!B6").Text & _
Chr(10) & _
"&""Arial,Italic""&8Approval Date: " & _
Range("Sheet1!B8").Text



With sh.PageSetup
.LeftHeader = sStr
.CenterHeader = ""
.RightHeader = sStr1
End With
End Sub


worked for me.

 

[retseort]

Thanks Tom. However I already got a different code written. Could yo
look at it? This works for me but I can't get the footer to a differen
font size. I.E. 8pt font. It seems to be defaulting and nothing I hav
tried will override the default.

I only need the footer to be reduced in font size. The code below i
without my attempts to control this.

Sub SetHeader(sh As Worksheet)
Dim lStr As String
Dim rStr As String
Dim dStr As String

With Worksheets("HeaderPage")

lStr = .Range("J2") & vbCr & .Range("J3") & vbCr
.Range("J4")
rStr = .Range("M2") & vbCr & .Range("M3") & vbCr
.Range("M4")
dStr = .Range("W1") & vbCr & .Range("W2") & vbCr & .Range("W3"
& vbCr & .Range("W4")
End With

With sh.PageSetup
.LeftHeader = lStr
.RightHeader = rStr
.CenterFooter = dStr

End With
End Sub


Thanks
Da

 

[retseort]

Thanks Tom. However I already got a different code written. Could yo
look at it? This works for me but I can't get the footer to a differen
font size. I.E. 8pt font. It seems to be defaulting and nothing I hav
tried will override the default.

I only need the footer to be reduced in font size. The code below i
without my attempts to control this.

Sub SetHeader(sh As Worksheet)
Dim lStr As String
Dim rStr As String
Dim dStr As String

With Worksheets("HeaderPage")

lStr = .Range("J2") & vbCr & .Range("J3") & vbCr
.Range("J4")
rStr = .Range("M2") & vbCr & .Range("M3") & vbCr
.Range("M4")
dStr = .Range("W1") & vbCr & .Range("W2") & vbCr & .Range("W3"
& vbCr & .Range("W4")
End With

With sh.PageSetup
.LeftHeader = lStr
.RightHeader = rStr
.CenterFooter = dStr

End With
End Sub


Thanks
Da

 

[retseort]

Thanks Tom!!!!!

This code pulls data from specific cells and pupulates it into the
header and footer. It loops to each sheet so no matter how many sheets
are added they all get the same header and footer. It adjusts the font
size to 6pt for the footer and it turns off screen flicker.

Here is my code for all that might need it.....


Found in This Workbook

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim wkSht As Worksheet
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)
Dim wkSht As Worksheet
Application.ScreenUpdating = False

For Each wkSht In ThisWorkbook.Worksheets

SetHeader wkSht

Next wkSht
Application.ScreenUpdating = True
End Sub


Found in Module 1

Sub SetHeader(sh As Worksheet)
Dim lStr As String
Dim rStr As String
Dim dStr As String

With Worksheets("HeaderPage")
Application.ScreenUpdating = False
lStr = .Range("J2") & vbCr & .Range("J3") & vbCr &
Range("J4")
rStr = .Range("M2") & vbCr & .Range("M3") & vbCr & .Range("M4")
& vbCr & .Range("M5") & vbCr & .Range("M6")
dStr = "&6" & Range("W1") & vbCr & .Range("W2") & vbCr &
Range("W3") & vbCr & .Range("W4")
End With

With sh.PageSetup
LeftHeader = lStr
RightHeader = rStr
CenterFooter = dStr
End With

With ActiveSheet.PageSetup
TopMargin = Application.InchesToPoints(1.44)
BottomMargin = Application.InchesToPoints(1)

End With
End Sub