Planet PDF Forum Archive

Planet PDF ForumWowsers! This is page is old, head to the LIVE Planet PDF Forum. It features more than 10 conferences, covering everything from beginner to in-depth developer and pre-press discussions. If you wish to continue... one & two archive covers 1999-2011 (160,000 pages).


New Forum | Previous | Next | (P-PDF) Developers


Topic: Excel 2000 VBA printing macro to PDF
Conf: (P-PDF) Developers, Msg: 53160
From: ArvyIS
Date: 5/29/2002 04:57 PM

I am fairly new to the VBA coding environment.
My situation is that I have inherited an old Excel
(1995) spreadsheet containing a printing macro that was recorded using the "Tools/Macro/Record Macro"
function.  The macro prints output to the user's
default printer.  How do I re-direct the output
inside the VBA printing macro to give the option of 
either printing to the default printer or creating a
pdf file?  The spreadsheet is very large
(approximately 20 pages - hard copy).  Does anyone
know the specific VBA coding to perfrom this?  I have
included the current macro code below.  Thank you in
advance.
'
' Print_Monthly_Quickly Macro
' Macro recorded 9/26/95 by Dell Portable
'
' This macro's font size and row height formats are for
' Number9GXE64HawkEye Larger Font monitor display
'
'Print Show statements have been REMmed out
'
Sub Print_Monthly_N9HawkEyeLargerFont()

Rem Print Comparison page
       Call SETUP
Rem    Range("comparison").Select
Rem    With Selection.Font
Rem        .FontStyle = "Regular"
Rem        .Size = 21
Rem        .Strikethrough = False
Rem        .Superscript = False
Rem        .Subscript = False
Rem        .OutlineFont = False
Rem        .Shadow = False
Rem        .Underline = xlNone
Rem    End With
Rem    Selection.RowHeight = 25
Rem    Range("comparison_footnote").Select
Rem    With Selection.Font
Rem        .FontStyle = "Regular"
Rem        .Size = 15
Rem        .Strikethrough = False
Rem        .Superscript = False
Rem        .Subscript = False
Rem        .OutlineFont = False
Rem        .Shadow = False
Rem        .Underline = xlNone
Rem    End With
Rem    Selection.RowHeight = 20
Rem        Range("comparison").Select
Rem    With ActiveSheet.PageSetup
Rem        .PrintTitleRows = ""
Rem        .PrintTitleColumns = ""
Rem    End With
Rem    ActiveSheet.PageSetup.PrintArea = "comparison"
Rem    With ActiveSheet.PageSetup
Rem        .LeftHeader = ""
Rem        .CenterHeader = ""
Rem        .RightHeader = ""
Rem        .LeftFooter = ""
Rem        .CenterFooter = "&""Arial,Regular""&15&P"
Rem        .RightFooter = ""
Rem        .LeftMargin = Application.InchesToPoints(0.5)
Rem        .RightMargin = Application.InchesToPoints(0.41)
Rem        .TopMargin = Application.InchesToPoints(0.57)
Rem        .BottomMargin = Application.InchesToPoints(0.52)
Rem        .HeaderMargin = Application.InchesToPoints(0.31)
Rem        .FooterMargin = Application.InchesToPoints(0.25)
Rem        .PrintHeadings = False
Rem        .PrintGridlines = False
Rem        .PrintNotes = False
Rem        .CenterHorizontally = True
Rem        .CenterVertically = True
Rem        .Orientation = xlPortrait
Rem        .Draft = False
Rem        .PaperSize = xlPaperLetter
Rem        .FirstPageNumber = 29
Rem        .Order = xlDownThenOver
Rem        .BlackAndWhite = False
Rem        .Zoom = False
Rem        .FitToPagesWide = 1
Rem        .FitToPagesTall = 1
Rem    End With
Rem Application.Wait Now + TimeValue("00:00:03")
Rem    Selection.PrintOut Copies:=1
Rem, Preview:=True
    

Rem Print Summary Page 1
    Range("allsum").Select
    With Selection.Font
        .FontStyle = "Regular"
        .Size = 24
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlNone
    End With
  Selection.RowHeight = 30
  Range("smalltitle").Select
    With Selection.Font
        .FontStyle = "Regular"
        .Size = 19
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlNone
    End With
    Selection.Font.Bold = True
    Range("TITLE").Select
        Selection.Font.Bold = True
    Range("title2").Select
        Selection.Font.Bold = True
    Range("footnotes").Select
    With Selection.Font
        .FontStyle = "Regular"
        .Size = 21
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlNone
     End With
          Selection.RowHeight = 27
    Columns("B:B").ColumnWidth = 70
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$2:$9"
        .PrintTitleColumns = "$A:$B"
    End With
    ActiveSheet.PageSetup.PrintArea = "summ1"
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "&""Arial,Regular""&24&P"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.33)
        .RightMargin = Application.InchesToPoints(0.33)
        .TopMargin = Application.InchesToPoints(0.35)
        .BottomMargin = Application.InchesToPoints(0.3)
        .HeaderMargin = Application.InchesToPoints(0.31)
        .FooterMargin = Application.InchesToPoints(0.2)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintNotes = False
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = 6
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 34
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True
    
    
Rem Print Summary Page 2
   Columns("B:B").ColumnWidth = 68
    Range("allsum").Select
    Selection.RowHeight = 29
            With ActiveSheet.PageSetup
        .PrintTitleRows = "$2:$9"
        .PrintTitleColumns = "$A:$B"
    End With
    ActiveSheet.PageSetup.PrintArea = "summ2"
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "&""Arial,Regular""&24&P"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.41)
        .TopMargin = Application.InchesToPoints(0.57)
        .BottomMargin = Application.InchesToPoints(0.52)
        .HeaderMargin = Application.InchesToPoints(0.31)
        .FooterMargin = Application.InchesToPoints(0.25)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintNotes = False
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = 7
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True
    
Rem Print Summary Page 3
    Range("allsum").Select
    Selection.RowHeight = 30
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$2:$9"
        .PrintTitleColumns = "$A:$B"
    End With
    ActiveSheet.PageSetup.PrintArea = "summ3"
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "&""Arial,Regular""&24&P"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.41)
        .TopMargin = Application.InchesToPoints(0.47)
        .BottomMargin = Application.InchesToPoints(0.52)
        .HeaderMargin = Application.InchesToPoints(0.31)
        .FooterMargin = Application.InchesToPoints(0.25)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintNotes = False
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = 8
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
   ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True

Rem Print ICU Page 1
    Columns("B:B").ColumnWidth = 28
    Range("allservice").Select
    With Selection.Font
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlNone
    End With
    Selection.RowHeight = 15
    Range("TITLE").Select
        Selection.Font.Bold = True
    Range("title2").Select
        Selection.Font.Bold = True
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$2:$9"
        .PrintTitleColumns = "$A:$B"
    End With
    ActiveSheet.PageSetup.PrintArea = "icu1"
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "&""Arial,Regular""&9&P"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.35)
        .RightMargin = Application.InchesToPoints(0.28)
        .TopMargin = Application.InchesToPoints(0.2)
        .BottomMargin = Application.InchesToPoints(0.39)
        .HeaderMargin = Application.InchesToPoints(0.2)
        .FooterMargin = Application.InchesToPoints(0.25)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintNotes = False
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = 9
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True
    
Rem Print ICU Page 2
    Range("allservice").Select
    Selection.RowHeight = 14.7
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$2:$9"
        .PrintTitleColumns = "$A:$B"
    End With
    ActiveSheet.PageSetup.PrintArea = "icu2"
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "&""Arial,Regular""&9&P"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.24)
        .RightMargin = Application.InchesToPoints(0.32)
        .TopMargin = Application.InchesToPoints(0.2)
        .BottomMargin = Application.InchesToPoints(0.39)
        .HeaderMargin = Application.InchesToPoints(0.2)
        .FooterMargin = Application.InchesToPoints(0.25)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintNotes = False
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = 10
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$2:$9"
        .PrintTitleColumns = "$A:$B"
    End With
    ActiveSheet.PageSetup.PrintArea = "icu2"
   ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True


Rem Print Med/Surg & OB page 1
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$2:$9"
        .PrintTitleColumns = "$A:$B"
    End With
    Columns("B:B").ColumnWidth = 39
    Range("allservice").Select
    With Selection.Font
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlNone
    End With
    Selection.RowHeight = 20
    Range("TITLE").Select
        Selection.Font.Bold = True
    Range("title2").Select
        Selection.Font.Bold = True
    Range("footnotes").Select
    With Selection.Font
        .FontStyle = "Regular"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlNone
     End With
         Selection.RowHeight = 15
    ActiveSheet.PageSetup.PrintArea = "medob1"
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "&""Arial,Regular""&11&P"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.35)
        .BottomMargin = Application.InchesToPoints(0.39)
        .HeaderMargin = Application.InchesToPoints(0.2)
        .FooterMargin = Application.InchesToPoints(0.2)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintNotes = False
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = 11
        .Order = xlDownThenOver
        .BlackAndWhite = False
Rem        .Zoom = 60
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
   ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True
    
Rem Print Med/Surg & OB Page 2
        Range("allservice").Select
        Selection.RowHeight = 19
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$2:$9"
        .PrintTitleColumns = "$A:$B"
    End With
    Columns("B:B").ColumnWidth = 39
    ActiveSheet.PageSetup.PrintArea = "medob2"
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "&""Arial,Regular""&11&P"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.35)
        .BottomMargin = Application.InchesToPoints(0.42)
        .HeaderMargin = Application.InchesToPoints(0.2)
        .FooterMargin = Application.InchesToPoints(0.2)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintNotes = False
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = 12
        .Order = xlDownThenOver
        .BlackAndWhite = False
Rem        .Zoom = 61
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
   ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True

Rem Print Ped & Psy page 1
    Range("comteachtitle").Select
    With Selection.Font
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlNone
    End With
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$2:$9"
        .PrintTitleColumns = "$A:$B"
    End With
    Columns("B:B").ColumnWidth = 39
    Range("allservice").Select
    Selection.RowHeight = 20
    ActiveSheet.PageSetup.PrintArea = "pedpsy1"
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "&""Arial,Regular""&11&P"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.35)
        .BottomMargin = Application.InchesToPoints(0.39)
        .HeaderMargin = Application.InchesToPoints(0.2)
        .FooterMargin = Application.InchesToPoints(0.2)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintNotes = False
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = 13
        .Order = xlDownThenOver
        .BlackAndWhite = False
Rem        .Zoom = 60
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True
    
Rem Print Ped & Psy Page 2
        Range("allservice").Select
        Selection.RowHeight = 19
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$2:$9"
        .PrintTitleColumns = "$A:$B"
    End With
        Columns("B:B").ColumnWidth = 39
    ActiveSheet.PageSetup.PrintArea = "pedpsy2"
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "&""Arial,Regular""&11&P"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.35)
        .BottomMargin = Application.InchesToPoints(0.42)
        .HeaderMargin = Application.InchesToPoints(0.2)
        .FooterMargin = Application.InchesToPoints(0.2)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintNotes = False
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = 14
        .Order = xlDownThenOver
        .BlackAndWhite = False
Rem        .Zoom = 58
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True
    
Rem Print SNF & Reh page 1
    Range("comteachtitle").Select
    With Selection.Font
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlNone
    End With
    Columns("B:B").ColumnWidth = 39
        Range("allservice").Select
        Selection.RowHeight = 20
        With ActiveSheet.PageSetup
        .PrintTitleRows = "$2:$9"
        .PrintTitleColumns = "$A:$B"
    End With
    ActiveSheet.PageSetup.PrintArea = "snfreh1"
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "&""Arial,Regular""&11&P"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.3)
        .BottomMargin = Application.InchesToPoints(0.42)
        .HeaderMargin = Application.InchesToPoints(0.25)
        .FooterMargin = Application.InchesToPoints(0.25)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintNotes = False
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = 15
        .Order = xlDownThenOver
        .BlackAndWhite = False
Rem        .Zoom = 63
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True
    
    Rem Print SNF, & Reh Page 2
        Columns("B:B").ColumnWidth = 38.5
        Range("allservice").Select
        Selection.RowHeight = 19
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$2:$9"
        .PrintTitleColumns = "$A:$B"
    End With
    ActiveSheet.PageSetup.PrintArea = "snfreh2"
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "&""Arial,Regular""&11&P"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.2)
        .RightMargin = Application.InchesToPoints(0.2)
        .TopMargin = Application.InchesToPoints(0.35)
        .BottomMargin = Application.InchesToPoints(0.42)
        .HeaderMargin = Application.InchesToPoints(0.25)
        .FooterMargin = Application.InchesToPoints(0.25)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintNotes = False
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = 16
        .Order = xlDownThenOver
        .BlackAndWhite = False
Rem        .Zoom = 59
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True
        
    Rem Print Special page 1
        Range("allservice").Select
    With Selection.Font
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlNone
    End With
    Selection.RowHeight = 20
    Range("TITLE").Select
        Selection.Font.Bold = True
    Range("TITLE2").Select
        Selection.Font.Bold = True
    Range("comteachtitle").Select
    With Selection.Font
        .Size = 13
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlNone
    End With

        Columns("B:B").ColumnWidth = 39
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$2:$9"
        .PrintTitleColumns = "$A:$B"
    End With
    ActiveSheet.PageSetup.PrintArea = "spec1"
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "&""Arial,Regular""&11&P"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.35)
        .BottomMargin = Application.InchesToPoints(0.39)
        .HeaderMargin = Application.InchesToPoints(0.25)
        .FooterMargin = Application.InchesToPoints(0.25)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintNotes = False
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = 17
        .Order = xlDownThenOver
        .BlackAndWhite = False
Rem        .Zoom = 64
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True
    
    Rem Print Special Page 2
        Columns("B:B").ColumnWidth = 39
        Range("allservice").Select
        Selection.RowHeight = 19
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$2:$9"
        .PrintTitleColumns = "$A:$B"
    End With
    ActiveSheet.PageSetup.PrintArea = "spec2"
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "&""Arial,Regular""&12&P"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.35)
        .BottomMargin = Application.InchesToPoints(0.42)
        .HeaderMargin = Application.InchesToPoints(0.25)
        .FooterMargin = Application.InchesToPoints(0.25)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintNotes = False
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = 18
        .Order = xlDownThenOver
        .BlackAndWhite = False
Rem        .Zoom = 60
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Preview:=True

Rem Call Reset
    End Sub

Sub Reset()
    Application.ActivePrinter = "LPT3:"
    Columns("B:B").ColumnWidth = 30
    Application.Goto Reference:="medsurghide"
    Selection.EntireColumn.Hidden = False
    Application.Goto Reference:="obhide"
    Selection.EntireColumn.Hidden = False
    Application.Goto Reference:="pedhide"
    Selection.EntireColumn.Hidden = False
    Application.Goto Reference:="psyhide"
    Selection.EntireColumn.Hidden = False
    Application.Goto Reference:="snfhide"
    Selection.EntireColumn.Hidden = False
    Application.Goto Reference:="rehhide"
    Selection.EntireColumn.Hidden = False
    Application.Goto Reference:="spechide"
    Selection.EntireColumn.Hidden = False
    Range("C90:L90").Select
    Selection.ColumnWidth = 12
    Range("allservice").Select
    With Selection.Font
        .FontStyle = "Regular"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlNone
    End With
    Selection.RowHeight = 16
    Range("C13").Select
        ActiveSheet.Protect DrawingObjects:=True, contents:=True, Scenarios _
        :=True
    Range("C9").Select
    ActiveWindow.FreezePanes = True

End Sub

Sub SETUP()
Rem Application.ActivePrinter = "Panasonic KX-P4455 v51.4 on LPT3:"
    Application.ActivePrinter = "LPT3:"
    ActiveSheet.Unprotect
    Range("C9").Select
    ActiveWindow.FreezePanes = False
    Range("C10").Select
    Selection.ColumnWidth = 16.75
    Range("D10").Select
    Selection.ColumnWidth = 14.38
    Range("E10").Select
    Selection.ColumnWidth = 20.25
    Range("F10").Select
    Selection.ColumnWidth = 20
    Range("G10").Select
    Selection.ColumnWidth = 26
    Range("H10").Select
    Selection.ColumnWidth = 20.88
    Range("I10").Select
    Selection.ColumnWidth = 15.25
    Range("J10").Select
    Selection.ColumnWidth = 17.13
    Range("K10").Select
    Selection.ColumnWidth = 21.88
    Range("L10").Select
    Selection.ColumnWidth = 24.63
    Range("M10").Select
    Selection.ColumnWidth = 16
    Application.Goto Reference:="medsurghide"
    Selection.EntireColumn.Hidden = True
    Application.Goto Reference:="obhide"
    Selection.EntireColumn.Hidden = True
    Application.Goto Reference:="pedhide"
    Selection.EntireColumn.Hidden = True
    Application.Goto Reference:="psyhide"
    Selection.EntireColumn.Hidden = True
    Application.Goto Reference:="snfhide"
    Selection.EntireColumn.Hidden = True
    Application.Goto Reference:="rehhide"
    Selection.EntireColumn.Hidden = True
    Application.Goto Reference:="spechide"
    Selection.EntireColumn.Hidden = True
End Sub


PDF In-Depth Free Product Trials Ubiquitous PDF

Debenu Aerialist

The ultimate plug-in for Adobe Acrobat. Advanced splitting, merging, stamping, bookmarking, and link...

Download free demo

Debenu PDF Tools Pro

It's simple to use and will let you preview and edit PDF files, it's a Windows application that makes...

Download free demo

Back to the past, 15 years ago! Open Publish 2002

Looking back to 2002, it's amazing how much of the prediction became a reality. Take a read and see what you think!

September 14, 2017
Platinum Sponsor





Search Planet PDF
more searching options...
Planet PDF Newsletter
Most Popular Articles
Featured Product

Debenu PDF Aerialist

The ultimate plug-in for Adobe Acrobat. Advanced splitting, merging, stamping, bookmarking, and link control. Take Acrobat to the next level.

Features

Adding a PDF Stamp Comment

OK, so you want to stamp your document. Maybe you need to give reviewers some advice about the document's status or sensitivity. This tip from author Ted Padova demonstrates how to add stamps with the Stamp Tool along with related comments.