Consulting

Results 1 to 3 of 3

Thread: word macro to print first page to different try

  1. #1
    VBAX Newbie
    Joined
    Oct 2007
    Posts
    1
    Location

    word macro to print first page to different try

    Hi,

    We have a place that has a print server with a few printers attached to. I created a macro to print to different tray but we are having a problem.

    This is the code: -
    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.

    The problem I have firstly is that when I am in word and click file>print>options and change default tray to tray 2 for example. It still prints to tray 3 so it completly ignores it which is why I had it changing the page setup as that is the only way it works.

    I am getting a problem though where it will then remember the page setup (set to tray 2, (letterhead)), when they actually just want to print normally.

    I need it where it will work on all machines and will not interfer with there default settings. I simply put two buttons on there menu which refers to printhp and printsharp so they have choice of two printer.

    The other problem I have is that i recorded the macro (changing the page setup and such for the sharp printer) but when i then put the code into the macro it ignores it.

    There was also a bit of a bizzare problem when when I click on sharp (printsharp) it would also print to the hp?? the other printer on there system.

    I think i must have messed something up but I cannot see what. Hopefully they can be ironed out.

    Thanks for you help
    k0r54

  2. #2
    I am bored today and this is similar to something I have worked on recently so I thought I'd have a play with it.

    The code I've written chooses trays based on your currently-selected printer and puts your tray back to the original setting when it's finished. It looks up the tray names/numbers in the function GetTrayName, which you're going to have to keep up to date unfortunately.

    Note, tray names and numbers sometimes change when printer drivers are updated.

    Here's the code (I recommend you have 'Option Explicit' at the top of your module):

    Main sub:
    [vba]Public Sub PrintMain()

    Dim lOriginalTray As Long
    Dim lPages As Long
    lPages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)

    With Options

    lOriginalTray = .DefaultTrayID

    If ChangeTray("Letter") Then

    Application.PrintOut _
    FileName:="", _
    Range:=wdPrintRangeOfPages, _
    Item:=wdPrintDocumentContent, _
    Copies:=1, _
    Pages:="1", _
    PageType:=wdPrintAllPages, _
    Collate:=True, _
    Background:=True, _
    PrintToFile:=False

    If lPages > 1 And ChangeTray("Plain") Then

    Application.PrintOut _
    FileName:="", _
    Range:=wdPrintRangeOfPages, _
    Item:=wdPrintDocumentContent, _
    Copies:=1, _
    Pages:="2-" & CStr(lPages), _
    PageType:=wdPrintAllPages, _
    Collate:=True, _
    Background:=True, _
    PrintToFile:=False

    Else
    MsgBox "Could not set Plain paper tray"
    End If

    Else
    MsgBox "Could not set letter paper tray"
    End If

    .DefaultTrayID = lOriginalTray

    End With

    End Sub[/vba] ChangeTray function:
    [vba]Private Function ChangeTray(TrayType As String) As Boolean

    On Error GoTo Err_ChangeTray

    Const lngIterations As Long = 5000
    Dim lngTrayID As Long
    Dim bSuccess As Boolean
    Dim sTrayName As String

    lngTrayID = 0
    bSuccess = False
    sTrayName = UCase(Trim(GetTrayName(TrayType)))

    With Options
    If IsNumeric(sTrayName) Then
    ' If TrayName is a number, just set tray to that
    .DefaultTrayID = CLng(sTrayName)
    bSuccess = True
    Else
    ' Loop through the first lngIterations possible tray options until
    ' we find one matching TrayName
    Do While lngTrayID <= lngIterations And _
    InStr(1, UCase(.DefaultTray), sTrayName, vbTextCompare) = 0
    lngTrayID = lngTrayID + 1
    .DefaultTrayID = lngTrayID
    Loop
    If UCase(Trim(.DefaultTray)) = sTrayName Then bSuccess = True
    End If
    End With

    Exit_ChangeTray:

    ChangeTray = bSuccess
    Exit Function

    Err_ChangeTray:

    bSuccess = False
    Resume Exit_ChangeTray

    End Function[/vba] GetTrayName function:
    [vba]Private Function GetTrayName(TrayType As String) As String

    Dim sPrinterName As String
    Dim sLetterTray As String
    Dim sPlainTray As String

    sPrinterName = UCase(Application.ActivePrinter)

    Select Case sPrinterName
    Case "\\JONESTERM\HP LASERJET 4250DTN PCL 6 (NEW OFFICE)"
    sLetterTray = " Tray 2"
    sPlainTray = " Tray 3"
    Case "\\JONESPRINT\HP 4200TN PCL 6 (2ND FLOOR)"
    sLetterTray = "260"
    sPlainTray = "257"
    Case "\\JONESPRINT\HP 4050 PCL6 (GROUND FLOOR)"
    sLetterTray = "260"
    sPlainTray = "259"
    Case "\\JONESPRINT\HP 4200TN PCL 6 2ND FLOOR (BIG OFFICE)"
    sLetterTray = "Tray 3"
    sPlainTray = "Tray 2"
    Case "\\JONESDATA\SHARP MX-2700N PCL6"
    sLetterTray = "Tray 3"
    sPlainTray = "Tray 2"
    Case "\\JONESDATA\SHARP AR-M351N PCL6"
    sLetterTray = "259"
    sPlainTray = "257"
    Case Else
    sLetterTray = ""
    sPlainTray = ""
    End Select

    If UCase(TrayType) = "LETTER" Then
    GetTrayName = sLetterTray
    Else
    GetTrayName = sPlainTray
    End If

    End Function[/vba]
    Regards

  3. #3
    VBAX Master TonyJollans's Avatar
    Joined
    May 2004
    Location
    Norfolk, England
    Posts
    2,291
    Location
    I haven't looked closely at the code but fellow Word MVP, Jonathan West has written a series of articles on Controlling the Printer from Word VBA, which you might find interesting, particularly Part 1: Using VBA to Select the Paper Tray
    Enjoy,
    Tony

    ---------------------------------------------------------------
    Give a man a fish and he'll eat for a day.
    Teach him how to fish and he'll sit in a boat and drink beer all day.

    I'm (slowly) building my own site: www.WordArticles.com

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •