Sub PrintHp()
LetterHeadRun ("\\jonesprint\HP 4200TN PCL 6 (2nd Floor)")
End Sub
Sub PrintSharp()
LetterHeadRun ("\\jonesprint\SHARP AR-M351N PCL6")
End Sub
Sub LetterHeadRun(PrinterToPrintTo)
'********** Version Control **********
'This code prints the first page of a document to letter headed paper.
'Any subsequent pages are printed to plain paper.
'A copy of all pages is then printed to plain paper.
'Arrangements have been made for the Windows Print Spooler Dialogue Box that informs
'Users that the print job is complete to be switched off, as multiple messages would
'be generated by this code. A replacement message is therefore generated once the code
'has printed the document.
'An Icon will be placed on the Standard Toolbar to run this code.
'This code should be stored in Normal.dot to ensure that it is available to all documents.
'Version 1.3
'? Adam Cosby Sep 2007
'************************************
'********** Declare Constants and Variables **********
' On Error keep going
On Error Resume Next
'Variable to hold the name of the tray containing Letter Head paper
Dim LetterHeadTray As Integer
'Variable to hold the message to be displayed in Message Boxes
Dim Message As String
'Variable to hold the name of the tray containing Plain paper
Dim PlainTray As Integer
'Variable to hold the Style of Message Boxes
Dim Style
'Variable to hold the Title of Message Boxes
Dim Title As String
'Variable to hold the number of pages in the document
Dim TotalPages As Integer
'Variable to hold the location of the active printer
Dim PrinterLocation As String
'Variable to hold the name of the active printer
Dim PrinterName As String
'Variable to receive the user response from Message Boxes
Dim Response
'*****************************************************
'********** Main Code **********
'Determine the Active Printer
PrinterName = LCase(PrinterToPrintTo)
'PrinterNameLength = Len(PrinterName) - 9
'PrinterName = Left(PrinterName, PrinterNameLength)
'Determine the number of pages to be printed
ActiveDocument.Repaginate
TotalPages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
'Set the names of the paper trays and the location for the Active Printer
If PrinterName = LCase("\\jonesterm\HP LaserJet 4250DTN PCL 6 (New Office)") Then
LetterHeadTray = " Tray 2"
PlainTray = " Tray 3"
PrinterLocation = "New Office"
Else
If PrinterName = LCase("\\jonesprint\HP 4200TN PCL 6 (2nd Floor)") Then
LetterHeadTray = 260
PlainTray = 257
PrinterLocation = "New Office"
Else
If PrinterName = LCase("\\jonesprint\HP 4050 PCL6 (Ground Floor)") Then
LetterHeadTray = 260
PlainTray = 259
PrinterLocation = "HHG OFFICE"
Else
If PrinterName = LCase("\\jonesprint\HP 4200TN PCL 6 2nd Floor (Big Office)") Then
LetterHeadTray = "Tray 3"
PlainTray = "Tray 2"
PrinterLocation = ""
Else
If PrinterName = LCase("\\jonesdata\SHARP MX-2700N PCL6") Then
LetterHeadTray = "Tray 3"
PlainTray = "Tray 2"
PrinterLocation = ""
Else
If PrinterName = LCase("\\jonesdata\SHARP AR-M351N PCL6") Then
LetterHeadTray = 259
PlainTray = 257
PrinterLocation = ""
End If
End If
End If
End If
End If
End If
'This displays the variables settings depending on the Active Printer
'!!!!It will be remarked out for the final code, as it may be useful for on site tests!!!!
'Message = "The Printer is " & PrinterName _
' & Chr(13) _
' & Chr(13) & "The Location is " & PrinterLocation _
' & Chr(13) _
' & Chr(13) & "The Letter Head Tray is " & LetterHeadTray _
' & Chr(13) _
' & Chr(13) & "The Plain Paper Tray is " & PlainTray
'Style = vbInformation
'Tile = "Printer Details"
'Response = MsgBox(Message, Style, Title)
'Exit Sub
'Send the first page to the printer's Letter Head Tray
With ActiveDocument.PageSetup
.FirstPageTray = LetterHeadTray
.OtherPagesTray = PlainTray
End With
Application.PrintOut _
FileName:="", _
Range:=wdPrintRangeOfPages, _
Item:=wdPrintDocumentContent, _
Copies:=1, _
Pages:="1", _
PageType:=wdPrintAllPages, _
Collate:=False, _
Background:=True, _
PrintToFile:=False, _
PrintZoomColumn:=0, _
PrintZoomRow:=0, _
PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
'Send any subsequent pages to the printer's Plain Paper Tray
If TotalPages > 1 Then
With ActiveDocument.PageSetup
.FirstPageTray = PlainTray
.OtherPagesTray = PlainTray
End With
Application.PrintOut _
FileName:="", _
Range:=wdPrintRangeOfPages, _
Item:=wdPrintDocumentContent, _
Copies:=1, _
Pages:="2-" & TotalPages, _
PageType:=wdPrintAllPages, _
Collate:=False, _
Background:=True, _
PrintToFile:=False, _
PrintZoomColumn:=0, _
PrintZoomRow:=0, _
PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
End If
'Send a second copy of the document to the printer's Plain Paper Tray
With ActiveDocument.PageSetup
.FirstPageTray = PlainTray
.OtherPagesTray = PlainTray
End With
Application.PrintOut _
FileName:="", _
Range:=wdPrintRangeOfPages, _
Item:=wdPrintDocumentContent, _
Copies:=1, _
Pages:="1-" & TotalPages, _
PageType:=wdPrintAllPages, _
Collate:=False, _
Background:=True, _
PrintToFile:=False, _
PrintZoomColumn:=0, _
PrintZoomRow:=0, _
PrintZoomPaperWidth:=0, _
PrintZoomPaperHeight:=0
'Display message to inform user that the print job has finished
'Message = "Your Print Job has been sent to: " & PrinterName _
' & Chr(13) _
' & Chr(13) & PrinterLocation
'Style = vbInformation
'Title = "Print Job Complete"
'Response = MsgBox(Message, Style, Title)
'Set back to tray three
With ActiveDocument.PageSetup
.FirstPageTray = PlainTray
.OtherPagesTray = PlainTray
End With
End Sub
Its really awkerward because different users use different printer which is why I made the LetterHeadRun they way I did.