D
D Franseen
I have a userform that inputs text in the range on "INFO."
I'd like to improve on the following macro in three specific areas:
1.) I'd like to set (lock) the font size to 11. (the &14 occurs because the
majority of the sheets that are printed are set to 77%, hence 11/.77=14)
I'd like to be able to rescale the worksheet area without changing the
header size. .Enableresize = False seems to do little. Is there away to
search out what the current sheet scaling is/will be at when it's printed
and then set the font size to the reciprocal of this in the header setup?
1a.) I'd like to fill the second line centerheader area with the contents of
"C4" much like the first line prints "c3." Unfortunately, I need to be
flexible in the number of characters that can be entered into each of the
cells back on "INFO," and this seems to cause difficulty. Additionally,
spaces " " don't seem to be printed if they are the last item in the header
area...hence &1.
2.) It's really slow when I have ten or so worksheets with four print area
pages each. Would 'with' help?
Since I'm way above my head anyhow, why does the custom menubar button that
runs this macro point to the last saved macro rather than the activesheet
macro by default? Swimming upsteam?
tia,
David
Sub CustomHeader()
On Error Resume Next
Application.ScreenUpdating = False
ProjInfoForm.Show
Set wf = Application.WorksheetFunction
A1Val = Sheets("INFO").Range("a1").Value
B2Val = Format(Sheets("INFO").Range("b2").Value, "mm/yyyy")
C3Val = Sheets("INFO").Range("c3")
C4val = Sheets("INFO").Range("c4")
D5Val = Sheets("INFO").Range("d5")
A1Len = Len(A1Val)
B2Len = Len(B2Val)
C3Len = Len(C3Val)
C4Len = Len(C4val)
D5Len = Len(D5Val)
For Each sht In ActiveWorkbook.Worksheets
' ActiveSheet.PageSetup.CenterHeader.EnableResize = False
sht.PageSetup.CenterHeader = ""
sht.PageSetup.LeftHeader = ""
sht.PageSetup.RightHeader = ""
sht.PageSetup.CenterHeader = _
"&""Arial,Regular""" & _
"&14" & _
"BY" & _
"&U" & _
" " & _
A1Val & wf.Rept(" ", 6 - A1Len) & _
"&U" & _
"DATE" & _
"&U" & " " & _
B2Val & wf.Rept(" ", 10 - B2Len) & _
"&U" & "SUBJECT" & "&U" & " " & _
C3Val & wf.Rept(" ", 46 - C3Len) & _
"&U" & "SHEET" & "&U" & " " & _
"&U" & "OF" & "&U" & " " & "&1." & "&U"
sht.PageSetup.LeftHeader = "&14" & Chr(13) & "CHKD. BY." & "&U" & "
" & _
"&U" & "DATE" & "&U" & wf.Rept(" ", 15) & "&1." & "&U"
sht.PageSetup.RightHeader = "&14" & Chr(13) & "CRS NO." & "&U " &
D5Val & _
wf.Rept(" ", 9 - D5Len) & " " & "&1." & "&U"
Next sht
Application.ScreenUpdating = True
End Sub
I'd like to improve on the following macro in three specific areas:
1.) I'd like to set (lock) the font size to 11. (the &14 occurs because the
majority of the sheets that are printed are set to 77%, hence 11/.77=14)
I'd like to be able to rescale the worksheet area without changing the
header size. .Enableresize = False seems to do little. Is there away to
search out what the current sheet scaling is/will be at when it's printed
and then set the font size to the reciprocal of this in the header setup?
1a.) I'd like to fill the second line centerheader area with the contents of
"C4" much like the first line prints "c3." Unfortunately, I need to be
flexible in the number of characters that can be entered into each of the
cells back on "INFO," and this seems to cause difficulty. Additionally,
spaces " " don't seem to be printed if they are the last item in the header
area...hence &1.
2.) It's really slow when I have ten or so worksheets with four print area
pages each. Would 'with' help?
Since I'm way above my head anyhow, why does the custom menubar button that
runs this macro point to the last saved macro rather than the activesheet
macro by default? Swimming upsteam?
tia,
David
Sub CustomHeader()
On Error Resume Next
Application.ScreenUpdating = False
ProjInfoForm.Show
Set wf = Application.WorksheetFunction
A1Val = Sheets("INFO").Range("a1").Value
B2Val = Format(Sheets("INFO").Range("b2").Value, "mm/yyyy")
C3Val = Sheets("INFO").Range("c3")
C4val = Sheets("INFO").Range("c4")
D5Val = Sheets("INFO").Range("d5")
A1Len = Len(A1Val)
B2Len = Len(B2Val)
C3Len = Len(C3Val)
C4Len = Len(C4val)
D5Len = Len(D5Val)
For Each sht In ActiveWorkbook.Worksheets
' ActiveSheet.PageSetup.CenterHeader.EnableResize = False
sht.PageSetup.CenterHeader = ""
sht.PageSetup.LeftHeader = ""
sht.PageSetup.RightHeader = ""
sht.PageSetup.CenterHeader = _
"&""Arial,Regular""" & _
"&14" & _
"BY" & _
"&U" & _
" " & _
A1Val & wf.Rept(" ", 6 - A1Len) & _
"&U" & _
"DATE" & _
"&U" & " " & _
B2Val & wf.Rept(" ", 10 - B2Len) & _
"&U" & "SUBJECT" & "&U" & " " & _
C3Val & wf.Rept(" ", 46 - C3Len) & _
"&U" & "SHEET" & "&U" & " " & _
"&U" & "OF" & "&U" & " " & "&1." & "&U"
sht.PageSetup.LeftHeader = "&14" & Chr(13) & "CHKD. BY." & "&U" & "
" & _
"&U" & "DATE" & "&U" & wf.Rept(" ", 15) & "&1." & "&U"
sht.PageSetup.RightHeader = "&14" & Chr(13) & "CRS NO." & "&U " &
D5Val & _
wf.Rept(" ", 9 - D5Len) & " " & "&1." & "&U"
Next sht
Application.ScreenUpdating = True
End Sub