Date Inserted in header
 

What i have is a macro that formatts the sheet that I run when I start
working on a sheet. What i am wondering is how to have it put todays date in
the center header box. Curently i have it putting in a 4 to hold the text
sizr formatting. **The text in the left headder is changed from actual
infomation because it contains compay information. But the one thing is that
the date cannot change. Once the date has been put in there i need it to
always be the same. Here is the macro Any help is very appreciated. Thank
you!!

Sub HeadderFooter()
'
' Macro1 Macro
' Macro recorded 8/17/2005 by cwa9821
'

'
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = "AKER****** "
.CenterHeader = "&20 4"
.RightHeader = ""
.LeftFooter = "By: MCone"
.CenterFooter = "&F"
.RightFooter = "Page &P of &N"
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1.83)
.BottomMargin = Application.InchesToPoints(0.8)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With
Selection.Merge Application.Dialogs(xlDialogPageSetup).Show
Range("A1").Select
ActiveCell.FormulaR1C1 = "See Markup of Attached Drawings for Shot
Locations"
Range("A1").Select
Selection.Font.Bold = True
Range("B1").Select
ActiveCell.FormulaR1C1 = "0"
Range("b1:R100").Select
Selection.NumberFormat = "0.00"
Selection.NumberFormat = "0.000"

End Sub

--
Message posted via http://www.officekb.com

Date Inserted in header
 

You will need to store the date somewhere on the sheet. The code below will
store it in the far right cell of row 1. You will only need to enter it once
for each new sheet.

Sub HeadderFooter()
'
' Macro1 Macro
' Macro recorded 8/17/2005 by cwa9821
'

'
Dim HdrDate As String
If Len(ActiveSheet.PageSetup.CenterHeader) 4 Then
'do nothing
Else
Range("IV1").Value = InputBox("Enter Header Date")
HdrDate = Range("IV1").Value
ActiveSheet.PageSetup.CenterHeader = "&20 " & HdrDate
End If

With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = "AKER****** "
.RightHeader = ""
.LeftFooter = "By: MCone"
.CenterFooter = "&F"
.RightFooter = "Page &P of &N"
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1.83)
.BottomMargin = Application.InchesToPoints(0.8)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With
Selection.Merge Application.Dialogs(xlDialogPageSetup).Show
Range("A1").Select
ActiveCell.FormulaR1C1 = "See Markup of Attached Drawings for Shot
Locations "
Range("A1").Select
Selection.Font.Bold = True
Range("B1").Select
ActiveCell.FormulaR1C1 = "0"
Range("b1:R100").Select
Selection.NumberFormat = "0.000"
Range("A1").Select
End Sub

Mike F

Date Inserted in header
 

Is There a way to make it so that the date will not change. The way it seems
to be working the date will change as the date changes. I need it to stay on
the date to stay on the date it was put in the headder.

Mike Fogleman wrote:
You will need to store the date somewhere on the sheet. The code below will
store it in the far right cell of row 1. You will only need to enter it once
for each new sheet.

Sub HeadderFooter()
'
' Macro1 Macro
' Macro recorded 8/17/2005 by cwa9821
'

'
Dim HdrDate As String
If Len(ActiveSheet.PageSetup.CenterHeader) 4 Then
'do nothing
Else
Range("IV1").Value = InputBox("Enter Header Date")
HdrDate = Range("IV1").Value
ActiveSheet.PageSetup.CenterHeader = "&20 " & HdrDate
End If

With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = "AKER****** "
.RightHeader = ""
.LeftFooter = "By: MCone"
.CenterFooter = "&F"
.RightFooter = "Page &P of &N"
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1.83)
.BottomMargin = Application.InchesToPoints(0.8)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With
Selection.Merge Application.Dialogs(xlDialogPageSetup).Show
Range("A1").Select
ActiveCell.FormulaR1C1 = "See Markup of Attached Drawings for Shot
Locations "
Range("A1").Select
Selection.Font.Bold = True
Range("B1").Select
ActiveCell.FormulaR1C1 = "0"
Range("b1:R100").Select
Selection.NumberFormat = "0.000"
Range("A1").Select
End Sub

Mike F

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200602/1

Date Inserted in header
 

Mark: That is exactly what this code does. You will input the date once in
the inputbox. The IF statement checks the length of the center header string
and if it is greater than 4 characters, does nothing and skips to End If.
For example if the header displays 2006, then the center header string is
"&20 2006". including the space, that is 8 characters. Since 8 is 4,
nothing happens and the 2006 stays intact. If there are 4 characters or less
then the header is empty ("") or only has the font size property but no text
("&20 "). If that is true, then the input box will ask you to enter a date,
which is then put into the header. The next time the macro is run, it will
see 8 characters in the header and do nothing.
The first time you run this macro the center header must be empty. If you
still have the "4" there, clear it out manually in the View/ Header Footer
menu.

Mike F
"Mark C via OfficeKB.com" <u12467@uwe wrote in message
news:5be1a1164e6ee@uwe...
Is There a way to make it so that the date will not change. The way it
seems
to be working the date will change as the date changes. I need it to stay
on
the date to stay on the date it was put in the headder.

Mike Fogleman wrote:
You will need to store the date somewhere on the sheet. The code below
will
store it in the far right cell of row 1. You will only need to enter it
once
for each new sheet.

Sub HeadderFooter()
'
' Macro1 Macro
' Macro recorded 8/17/2005 by cwa9821
'

'
Dim HdrDate As String
If Len(ActiveSheet.PageSetup.CenterHeader) 4 Then
'do nothing
Else
Range("IV1").Value = InputBox("Enter Header Date")
HdrDate = Range("IV1").Value
ActiveSheet.PageSetup.CenterHeader = "&20 " & HdrDate
End If

With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = "AKER****** "
.RightHeader = ""
.LeftFooter = "By: MCone"
.CenterFooter = "&F"
.RightFooter = "Page &P of &N"
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1.83)
.BottomMargin = Application.InchesToPoints(0.8)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With
Selection.Merge Application.Dialogs(xlDialogPageSetup).Show
Range("A1").Select
ActiveCell.FormulaR1C1 = "See Markup of Attached Drawings for Shot
Locations "
Range("A1").Select
Selection.Font.Bold = True
Range("B1").Select
ActiveCell.FormulaR1C1 = "0"
Range("b1:R100").Select
Selection.NumberFormat = "0.000"
Range("A1").Select
End Sub

Mike F

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200602/1

Date Inserted in header
 

Works Great!!

When I had tested it I had some text in the center header.

Thank you very Much!!!!

Mike Fogleman wrote:
Mark: That is exactly what this code does. You will input the date once in
the inputbox. The IF statement checks the length of the center header string
and if it is greater than 4 characters, does nothing and skips to End If.
For example if the header displays 2006, then the center header string is
"&20 2006". including the space, that is 8 characters. Since 8 is 4,
nothing happens and the 2006 stays intact. If there are 4 characters or less
then the header is empty ("") or only has the font size property but no text
("&20 "). If that is true, then the input box will ask you to enter a date,
which is then put into the header. The next time the macro is run, it will
see 8 characters in the header and do nothing.
The first time you run this macro the center header must be empty. If you
still have the "4" there, clear it out manually in the View/ Header Footer
menu.

Mike F
Is There a way to make it so that the date will not change. The way it
seems
[quoted text clipped - 70 lines]

Mike F

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...mming/200602/1