Re: Custom Header Macro

Tech Tip: Click here to run a free scan for Windows Errors and optimize PC performance

Le

Sub DoFullPath()
Active***.PageSetup.CenterHeader = ActiveWorkbook.Name & _
vbLf & Active***.Name
End Sub


Gord Dibben MS Excel MVP

On Wed, 10 Jan 2007 11:01:00 -0800, Le Jurassien <christkim@xxxxxxx> wrote:

Hello,

I am trying to set up custom header macro that will eliminate this extra
step that I have to do on each *** within my reports. I would like to have
the file name then just below the file name, the *** name. I am still
having trouble with specific code that I need to formulate. Can someone help?

Public Sub Add_Sheets()
For i = 13 To 1 Step -1
Worksheets.Add.Name = "Newsheet" & i
Next
End Sub

Public Sub PageSet()
Dim ws As Work***
For Each ws In ActiveWorkbook.Sheets
With ws.PageSetup
.Orientation = xlLandscape
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)


.PaperSize = xlPaperLegal

.FirstPageNumber = xlAutomatic
.CenterHeader = " "
.PrintErrors = xlPrintErrorsDisplayed
End With
Next ws
End Sub

Private Sub Workbook_Open()
Dim ws As Work***

For Each ws In ActiveWorkbook.Sheets
With ws.PageSetup
.Orientation = xlLandscape
.PaperSize = xlPaperLegal
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)

.FirstPageNumber = xlAutomatic
.CenterHeader = " "
.PrintErrors = xlPrintErrorsDisplayed
End With
Next ws
End Sub

Sub DoFullPath()
Active***.PageSetup.CenterHeader = _
ActiveWorkbook.Name


End Sub

Thanks,

.

Quantcast