Printing Setup help

V

Vacuum Sealed

Hi Everyone

I used the Macro Recorder to setup a quick-print.

Fairly straight-forward requirement.

1. Set the range of the sheet that has data.
2. Set the PrintArea (Including Orientation & Margins defined)
3. Insert Centre Header (including the Date as formatted)
4. Print Preview

Sub PrintHDC()

Dim SS As Worksheet
Dim Rng As Range
Dim myDate As Date

Set SS = Sheets("HDC")
Set Rng = SS.Range("A1:L" & Rows.Count) ' Select only the the range that
has data as it will vary everyday

myDate = Format(D, "Ddd, dd-Mmm-yy") ' to be included in the Page Header

With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
End With

ActiveSheet.PageSetup.PrintArea= (" ") ' This is the bit where it hangs
as I don't know what to insert here to define the variable print area
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = "&16HDC - &myDate" ' And this is the other problem,
how to incorporate the "Page Header Title" &" - "& myDate as it does not
auto-recognise it from the Dim Statement as it says its a (Type Mis-Match)
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.33)
.RightMargin = Application.InchesToPoints(0.12)
.TopMargin = Application.InchesToPoints(0.49)
.BottomMargin = Application.InchesToPoints(0.21)
.HeaderMargin = Application.InchesToPoints(0.16)
.FooterMargin = Application.InchesToPoints(0.12)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
ActiveWindow.SelectedSheets.PrintPreview
End Sub


TIA
Mick
 
J

Javed

Hope this will do.................

Sub PrintHDC()

Dim SS As Worksheet
Dim Rng As Range
Dim myDate As String

Set SS = Sheets("HDC")
Set Rng = Application.InputBox(prompt:="Pls select the range",
Default:=SS.UsedRange.Address, Type:=8)

myDate = Format(Date, "Ddd, dd-Mmm-yy")


With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintArea = Rng
.LeftHeader = ""
.CenterHeader = "Page Header Title - " & myDate
.LeftMargin = Application.InchesToPoints(0.33)
.RightMargin = Application.InchesToPoints(0.12)
.TopMargin = Application.InchesToPoints(0.49)
.BottomMargin = Application.InchesToPoints(0.21)
.HeaderMargin = Application.InchesToPoints(0.16)
.FooterMargin = Application.InchesToPoints(0.12)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
End With
ActiveWindow.SelectedSheets.PrintPreview
End Sub
 
V

Vacuum Sealed

Thank you Javed

The InputBox was Excellent as I didn't really need to physically input the
range as it automatically set it as soon as the InputBox opened.

But it halted on:
..PrintArea = Rng

So I changed it to:
..PrintArea = SS.UsedRange.Address

This help it step over that little hurdle.

Then everything with a (.) in the With Statement after that either had the
CPU In a continuous loop or just had to think real hard about what to do
next, and each time I hit <CTRL>Break it stopped at a different point within
the "With Statement".

I was wondering if it would be easy to use the .FitWide / .FitTall, but with
a slight twist using an "If" or "Case" to set it to the correct length.

eg.

If PrintArea.PrintPages = 1 then
..FitPageWide= 1
..FitPageTall = 1

Else
If PrintArea.PrintPages = 2 then
..FitPageWide= 1
..FitPageTall = 2

Else
If PrintArea.PrintPages = 3 then
..FitPageWide= 1
..FitPageTall = 3

Etc

End If

This would then hopefully remove the need for setting all the other (.)
parameters within as the sheet would already be setup to a certain point,
with the exception of the length of the range which would ultimately
determine how many pages would print.

Cheers
Mick
 
G

GS

Vacuum Sealed wrote on 1/20/2011 :
Thank you Javed

The InputBox was Excellent as I didn't really need to physically input the
range as it automatically set it as soon as the InputBox opened.

But it halted on:
.PrintArea = Rng

So I changed it to:
.PrintArea = SS.UsedRange.Address

This help it step over that little hurdle.

Then everything with a (.) in the With Statement after that either had the
CPU In a continuous loop or just had to think real hard about what to do
next, and each time I hit <CTRL>Break it stopped at a different point within
the "With Statement".

I was wondering if it would be easy to use the .FitWide / .FitTall, but with
a slight twist using an "If" or "Case" to set it to the correct length.

eg.

If PrintArea.PrintPages = 1 then
.FitPageWide= 1
.FitPageTall = 1

Else
If PrintArea.PrintPages = 2 then
.FitPageWide= 1
.FitPageTall = 2

Else
If PrintArea.PrintPages = 3 then
.FitPageWide= 1
.FitPageTall = 3

Etc

End If

This would then hopefully remove the need for setting all the other (.)
parameters within as the sheet would already be setup to a certain point,
with the exception of the length of the range which would ultimately
determine how many pages would print.

Cheers
Mick

Did you know that setting you can FitPageWide and leave FitPageTall
empty so Excel handles the number of pages for you?
 
G

GS

GS presented the following explanation :
Did you know that setting you can FitPageWide and leave FitPageTall empty so
Excel handles the number of pages for you?

Geez.., I was in a hurry to catch a bus when I was replying. This
should read...

"Did you know that you can set FitPagesWide and leave FitPagesTall
empty to have Excel handle the number of pages for you?"

Sorry about that!<g>
 
V

Vacuum Sealed

Thx Garry

I actually didn't, but that's why I keep visiting this NG.

Every visit is educational.

Cheers
Mick
 
V

Vacuum Sealed

Garry

I tried leaving the FitPageTall empty but it halts on it.

Here the code I'm trying to get up and running:

Sub PrintHDC()

Dim theDay As String
Dim theDate As String
Dim myDate As String

theDay = Format(Date, "Ddd")

If theDay = "Mon" Then
theDate = Date - 3
Else
theDate = Date - 1
End If

myDate = Format(theDate, "Ddd, dd-Mmm-yy")

Application.ActivePrinter = "\\SPRN01\WOW HDC on Ne01:"

Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select

With ActiveSheet.PageSetup
.PrintArea = Selection.Address
.PrintTitleRows = "$1:$1"
.CenterHeader = "HDC - " & myDate
.FitToPagesWide = 1
.FitToPagesTall = ""
End With

ActiveWindow.SelectedSheets.PrintPreview

End Sub


it halts on FitToPagesTall

TIA
Mick
 
G

GS

Vacuum Sealed explained :
Garry

I tried leaving the FitPageTall empty but it halts on it.

Here the code I'm trying to get up and running:

Sub PrintHDC()

Dim theDay As String
Dim theDate As String
Dim myDate As String

theDay = Format(Date, "Ddd")

If theDay = "Mon" Then
theDate = Date - 3
Else
theDate = Date - 1
End If

myDate = Format(theDate, "Ddd, dd-Mmm-yy")

Application.ActivePrinter = "\\SPRN01\WOW HDC on Ne01:"

Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select

With ActiveSheet.PageSetup
.PrintArea = Selection.Address
.PrintTitleRows = "$1:$1"
.CenterHeader = "HDC - " & myDate
.FitToPagesWide = 1
.FitToPagesTall = ""
End With

ActiveWindow.SelectedSheets.PrintPreview

End Sub


it halts on FitToPagesTall

TIA
Mick

Try moving the line that sets the active printer down to just above...

ActiveWindow.SelectedSheets.PrintPreview.
 
V

Vacuum Sealed

Garry

Thank you so much for your valuable assistance.

Finally got it where it is working nicely.

I will post the final code here shortly.

Cheers
Mick.
 
V

Vacuum Sealed

Garry & All

As promised here is the final working very well code:

Sub PrintHDC()

Dim theDay As String
Dim theDate As String
Dim myDate As String

theDay = Format(Date, "Ddd")

If theDay = "Mon" Then
theDate = Date - 3
Else
theDate = Date - 1
End If

myDate = Format(theDate, "Ddd, dd-Mmm-yy")

Columns("L:L").Select
Selection.ColumnWidth = 30

Cells.Select
With Selection
.WrapText = True
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"
.CenterHeader = "HDC - " & myDate
.FitToPagesWide = 1
End With

Application.ActivePrinter = "\\SPRN01\WOW HDC on Ne01:"
ActiveWindow.SelectedSheets.PrintPreview

End Sub

Cheers
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top