V
Vacuum Sealed
Hi everyone
I am having problems with the Custom Header and making it display what I
want in 4 seperate reports, being:
PrintHDC
PrintLDC
PrintNDC
PrintRDC
Once I have done the HDC Report and I go to print the LDC Report it keeps
the HDC Custom Header, even though I have command lines to make it blank,
both at the end and start of each Sub() just to make sure it clears, to no
avail.....
This occurs with all of the remaining reports also, the only way I have of
placing the Custom Header details I want there is to do it manually, which
kinda defeats the purpose of using VB in the first place...
Sub PrintHDC()
Dim myDate As String
With Application
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlManual
End With
myDate = Format(Date, "Ddd, dd-Mmm-yy")
With ActiveSheet.PageSetup
.LeftHeader = ""
.RightHeader = ""
.PrintArea = ""
End With
Columns("L:L").Select
Selection.ColumnWidth = 30
Columns("K:K").Select
With Selection
.HorizontalAlignment = xlCenter
End With
Cells.Select
With Selection
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows("2:200").Select
Selection.Rows.AutoFit
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
With ActiveSheet.PageSetup
.PrintArea = Selection.Address
.PrintTitleRows = "$1:$1"
.LeftHeader = "H. D.C."
.RightHeader = myDate
.FitToPagesWide = 1
End With
Application.ActivePrinter = "\\SPRN01\WOW on Ne00:"
ActiveWindow.SelectedSheets.PrintPreview
With ActiveSheet.PageSetup
.LeftHeader = ""
.RightHeader = ""
.PrintArea = ""
End With
End Sub
Sub PrintLDC()
Dim myDate As String
myDate = Format(Date, "Ddd, dd-Mmm-yy")
With ActiveSheet.PageSetup
.LeftHeader = ""
.RightHeader = ""
.PrintArea = ""
End With
Columns("L:L").Select
Selection.ColumnWidth = 30
Columns("K:K").Select
With Selection
.HorizontalAlignment = xlCenter
End With
Cells.Select
With Selection
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows("2:200").Select
Selection.Rows.AutoFit
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
With ActiveSheet.PageSetup
.PrintArea = Selection.Address
.PrintTitleRows = "$1:$1"
.LeftHeader = "L.D.C."
.RightHeader = myDate
.FitToPagesWide = 1
End With
Application.ActivePrinter = "\\SPRN01\WOW on Ne00:"
ActiveWindow.SelectedSheets.PrintPreview
With ActiveSheet.PageSetup
.LeftHeader = ""
.RightHeader = ""
.PrintArea = ""
End With
End Sub
Sub PrintNDC()
Dim myDate As String
myDate = Format(Date, "Ddd, dd-Mmm-yy")
With ActiveSheet.PageSetup
.LeftHeader = ""
.RightHeader = ""
.PrintArea = ""
End With
Columns("L:L").Select
Selection.ColumnWidth = 30
Columns("K:K").Select
With Selection
.HorizontalAlignment = xlCenter
End With
Cells.Select
With Selection
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows("2:200").Select
Selection.Rows.AutoFit
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
With ActiveSheet.PageSetup
.PrintArea = Selection.Address
.PrintTitleRows = "$1:$1"
.LeftHeader = "N.D.C."
.RightHeader = myDate
.FitToPagesWide = 1
End With
Application.ActivePrinter = "\\SPRN01\WOW on Ne00:"
ActiveWindow.SelectedSheets.PrintPreview
With ActiveSheet.PageSetup
.LeftHeader = ""
.RightHeader = ""
.PrintArea = ""
End With
End Sub
Sub PrintRDC()
Dim myDate As String
myDate = Format(Date, "Ddd, dd-Mmm-yy")
With ActiveSheet.PageSetup
.LeftHeader = ""
.RightHeader = ""
.PrintArea = ""
End With
Columns("L:L").Select
Selection.ColumnWidth = 25
Columns("K:K").Select
With Selection
.HorizontalAlignment = xlCenter
End With
Cells.Select
With Selection
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows("2:200").Select
Selection.Rows.AutoFit
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
With ActiveSheet.PageSetup
.PrintArea = Selection.Address
.PrintTitleRows = "$1:$1"
.LeftHeader = "R.D.C."
.RightHeader = myDate
.FitToPagesWide = 1
End With
Application.ActivePrinter = "\\SPRN01\WOW on Ne00:"
ActiveWindow.SelectedSheets.PrintPreview
With ActiveSheet.PageSetup
.LeftHeader = ""
.RightHeader = ""
.PrintArea = ""
End With
With Application
.EnableEvents = True
.ScreenUpdating = True
.Calculation = xlAutomatic
End With
End Sub
TIA
Mick
I am having problems with the Custom Header and making it display what I
want in 4 seperate reports, being:
PrintHDC
PrintLDC
PrintNDC
PrintRDC
Once I have done the HDC Report and I go to print the LDC Report it keeps
the HDC Custom Header, even though I have command lines to make it blank,
both at the end and start of each Sub() just to make sure it clears, to no
avail.....
This occurs with all of the remaining reports also, the only way I have of
placing the Custom Header details I want there is to do it manually, which
kinda defeats the purpose of using VB in the first place...
Sub PrintHDC()
Dim myDate As String
With Application
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlManual
End With
myDate = Format(Date, "Ddd, dd-Mmm-yy")
With ActiveSheet.PageSetup
.LeftHeader = ""
.RightHeader = ""
.PrintArea = ""
End With
Columns("L:L").Select
Selection.ColumnWidth = 30
Columns("K:K").Select
With Selection
.HorizontalAlignment = xlCenter
End With
Cells.Select
With Selection
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows("2:200").Select
Selection.Rows.AutoFit
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
With ActiveSheet.PageSetup
.PrintArea = Selection.Address
.PrintTitleRows = "$1:$1"
.LeftHeader = "H. D.C."
.RightHeader = myDate
.FitToPagesWide = 1
End With
Application.ActivePrinter = "\\SPRN01\WOW on Ne00:"
ActiveWindow.SelectedSheets.PrintPreview
With ActiveSheet.PageSetup
.LeftHeader = ""
.RightHeader = ""
.PrintArea = ""
End With
End Sub
Sub PrintLDC()
Dim myDate As String
myDate = Format(Date, "Ddd, dd-Mmm-yy")
With ActiveSheet.PageSetup
.LeftHeader = ""
.RightHeader = ""
.PrintArea = ""
End With
Columns("L:L").Select
Selection.ColumnWidth = 30
Columns("K:K").Select
With Selection
.HorizontalAlignment = xlCenter
End With
Cells.Select
With Selection
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows("2:200").Select
Selection.Rows.AutoFit
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
With ActiveSheet.PageSetup
.PrintArea = Selection.Address
.PrintTitleRows = "$1:$1"
.LeftHeader = "L.D.C."
.RightHeader = myDate
.FitToPagesWide = 1
End With
Application.ActivePrinter = "\\SPRN01\WOW on Ne00:"
ActiveWindow.SelectedSheets.PrintPreview
With ActiveSheet.PageSetup
.LeftHeader = ""
.RightHeader = ""
.PrintArea = ""
End With
End Sub
Sub PrintNDC()
Dim myDate As String
myDate = Format(Date, "Ddd, dd-Mmm-yy")
With ActiveSheet.PageSetup
.LeftHeader = ""
.RightHeader = ""
.PrintArea = ""
End With
Columns("L:L").Select
Selection.ColumnWidth = 30
Columns("K:K").Select
With Selection
.HorizontalAlignment = xlCenter
End With
Cells.Select
With Selection
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows("2:200").Select
Selection.Rows.AutoFit
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
With ActiveSheet.PageSetup
.PrintArea = Selection.Address
.PrintTitleRows = "$1:$1"
.LeftHeader = "N.D.C."
.RightHeader = myDate
.FitToPagesWide = 1
End With
Application.ActivePrinter = "\\SPRN01\WOW on Ne00:"
ActiveWindow.SelectedSheets.PrintPreview
With ActiveSheet.PageSetup
.LeftHeader = ""
.RightHeader = ""
.PrintArea = ""
End With
End Sub
Sub PrintRDC()
Dim myDate As String
myDate = Format(Date, "Ddd, dd-Mmm-yy")
With ActiveSheet.PageSetup
.LeftHeader = ""
.RightHeader = ""
.PrintArea = ""
End With
Columns("L:L").Select
Selection.ColumnWidth = 25
Columns("K:K").Select
With Selection
.HorizontalAlignment = xlCenter
End With
Cells.Select
With Selection
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Rows("2:200").Select
Selection.Rows.AutoFit
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
With ActiveSheet.PageSetup
.PrintArea = Selection.Address
.PrintTitleRows = "$1:$1"
.LeftHeader = "R.D.C."
.RightHeader = myDate
.FitToPagesWide = 1
End With
Application.ActivePrinter = "\\SPRN01\WOW on Ne00:"
ActiveWindow.SelectedSheets.PrintPreview
With ActiveSheet.PageSetup
.LeftHeader = ""
.RightHeader = ""
.PrintArea = ""
End With
With Application
.EnableEvents = True
.ScreenUpdating = True
.Calculation = xlAutomatic
End With
End Sub
TIA
Mick