Printing selections from sheets to PDF

[Mark McCall]

Excel 97

I have inherited some code to print selected areas (constant title
areas, and rolling data areas) from three worksheets from a
spreadsheet as three pages. We now wish to post this report onto our
corporate Intranet as a PDF.

I can change the default printer to Acrobat Distiller, but the problem
is that each page overwrites its predecessor. Ideally I would like to
produce a single, four page PDF, incorporating the three pages below,
and if possible, a Word file as a separate page. Until very recently,
this Word file was embedded into the spreadsheet (since commented
out), but this created more problems than it resolved (due to
compatibility issues, it needed to be distributed as an Excel 5 file).

Hope this is clear.

' PrintReport Macro
' Macro recorded 10/07/01 by ****** ******
' Modified 3 May 2002; 5 June 2003
'
Sub PrintReport()
Sheets("Graphs").Select
Range("A1:S44").Select
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = "&""National Blood Logo,Normal""&48abc"
.CenterHeader = "&12Donor Base Report"
.RightHeader = "Market Research and Analysis"
.LeftFooter = "&F &A"
.CenterFooter = ""
.RightFooter = "&D"
.LeftMargin = Application.InchesToPoints(0.748031496062992)
.RightMargin = Application.InchesToPoints(0.748031496062992)
.TopMargin = Application.InchesToPoints(0.984251968503937)
.BottomMargin = Application.InchesToPoints(0.984251968503937)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintNotes = False
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Selection.PrintOut Copies:=1
ActiveWindow.LargeScroll ToRight:=-1
ActiveWindow.ScrollRow = 1
' Range("A1:J55").Select
' With ActiveSheet.PageSetup
' .PrintTitleRows = ""
' .PrintTitleColumns = ""
'End With
' ActiveSheet.PageSetup.PrintArea = ""
' With ActiveSheet.PageSetup
' .LeftHeader = ""
' .CenterHeader = ""
' .RightHeader = ""
' .LeftFooter = ""
' .CenterFooter = ""
' .RightFooter = ""
' .LeftMargin = Application.InchesToPoints(0.748031496062992)
' .RightMargin = Application.InchesToPoints(0.748031496062992)
' .TopMargin = Application.InchesToPoints(0.984251968503937)
' .BottomMargin = Application.InchesToPoints(0.984251968503937)
' .HeaderMargin = Application.InchesToPoints(0.511811023622047)
' .FooterMargin = Application.InchesToPoints(0.511811023622047)
' .PrintHeadings = False
' .PrintGridlines = False
'.PrintNotes = False
' .PrintQuality = 600
' .CenterHorizontally = True
' .CenterVertically = False
' .Orientation = xlPortrait
' .Draft = False
' .PaperSize = xlPaperLetter
' .FirstPageNumber = xlAutomatic
' .Order = xlDownThenOver
'.BlackAndWhite = False
' .Zoom = False
' .FitToPagesWide = 1
' .FitToPagesTall = 1
' End With
'Selection.PrintOut Copies:=1
Sheets("Summary").Select
Range("B32:Q56").Select ' Change coordinates
With ActiveSheet.PageSetup
.PrintTitleRows = "$2:$3"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = "&""National Blood Logo,Normal""&36abc"
.CenterHeader = "Donor Base Report"
.RightHeader = "Market Research and Analysis"
.LeftFooter = "&F &A &D"
.CenterFooter = ""
.RightFooter = "Page &P"
.LeftMargin = Application.InchesToPoints(0.748031496062992)
.RightMargin = Application.InchesToPoints(0.748031496062992)
.TopMargin = Application.InchesToPoints(0.984251968503937)
.BottomMargin = Application.InchesToPoints(0.984251968503937)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintNotes = False
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Selection.PrintOut Copies:=1
Sheets("Recruitment by Activity State").Select
Range("B28:K40").Select ' Change coordinates
With ActiveSheet.PageSetup
.PrintTitleRows = "$2:$4"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = "&""National Blood Logo,Normal""&36abc"
.CenterHeader = "Donor Base Report"
.RightHeader = "Market Research and Analysis"
.LeftFooter = "&F &A &D"
.CenterFooter = ""
.RightFooter = "Page &P"
.LeftMargin = Application.InchesToPoints(0.748031496062992)
.RightMargin = Application.InchesToPoints(0.748031496062992)
.TopMargin = Application.InchesToPoints(0.984251968503937)
.BottomMargin = Application.InchesToPoints(0.984251968503937)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = True
.PrintNotes = False
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Selection.PrintOut Copies:=1
End Sub

Thanks for reading

Mark McCall
Market Research Analyst - Data