Home |
Search |
Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Printing selections from sheets to PDF
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Printing Sheets | Excel Discussion (Misc queries) | |||
How do I copy and move selections of data to other sheets? | Excel Worksheet Functions | |||
PRINTING two sheets on ONE? | Excel Discussion (Misc queries) | |||
Printing non-adjacent selections | New Users to Excel | |||
Printing sheets. | Excel Worksheet Functions |