Printing on XPS Printer

[BrendanDixon]

Hi All,

I have been trying to create a macro where I can print my Workbook as an XPS file using the XPS document Writer Driver.

This is my code so far:

Sub PRINT_UNKNOWN_Ne()
    Dim PrinterName As String
    Dim PortNumber As Integer
    Dim PrinterPort As String
    Dim PrinterFullName As String
    Dim PrinterFound As Boolean
    Dim STDprinter As String

    STDprinter = Application.ActivePrinter
    PrinterName = "Microsoft XPS Document Writer"
    PrinterFound = False
    On Error Resume Next
    For PortNumber = 0 To 12
        PrinterPort = "Ne" & Format(PortNumber, "00") & ":"
        PrinterFullName = PrinterName & PrinterNumber & " on " & PrinterPort
        Application.ActivePrinter = PrinterFullName
    Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
        ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
        If Err.Number = 0 Then
            PrinterFound = True
            Exit For
        Else
            Err.Clear
        End If
    
    Next PortNumber
    
    If PrinterFound = False Then
        MsgBox (PrinterName & vbCr & "Printer not found")
    End If
    
    Application.ActivePrinter = STDprinter
End Sub

The problems I am having is that it is also printing to my default printer on my computer. I noticed that without the STDprinter code the quickprint button from the menu would default to the XPS printer where I would like the default printer to change back to my computers default printer afterwards, and not print it on the default printer as well.

I would also like to set the filename automatically in the XPS document Does anyone know how I can do this ?

Thanks

 

[BrendanDixon]

Managed to fix which printer is selected. Here is the code:

Sub PRINT_UNKNOWN_Ne()
    Dim PrinterName As String
    Dim PortNumber As Integer
    Dim PrinterPort As String
    Dim PrinterFullName As String
    Dim PrinterFound As Boolean
    Dim STDprinter As String
    '-------------------------------------------------------------------------
    STDprinter = Application.ActivePrinter
    PrinterName = "Microsoft XPS Document Writer"
    PrinterFound = False
    On Error Resume Next       ' SET ERROR TRAPPING
    '-------------------------------------------------------------------------
    '- LOOP Ne: NUMBERS
    For PortNumber = 0 To 12
        PrinterPort = "Ne" & Format(PortNumber, "00") & ":"
        PrinterFullName = PrinterName & PrinterNumber & " on " & PrinterPort
        '---------------------------------------------------------------------
        '- TRY TO SET ACTIVEPRINTER
        Application.ActivePrinter = PrinterFullName
        '---------------------------------------------------------------------
        '- IF ERROR TRY NEXT PRINTER
        If Err.Number = 0 Then
            Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
            ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"    ' PRINT SHEET
        '    Filename:= (Sheets("Sheet").Range("A1").Value)
            PrinterFound = True
            Sheets(Array("Sheet1")).Select
            Exit For
        Else
            Err.Clear   ' clear for next error
        End If
        '---------------------------------------------------------------------
    Next PortNumber
    '-------------------------------------------------------------------------
    '- RESULT
    If PrinterFound Then
     '   MsgBox ("Successfully Saved With" & vbCr & PrinterFullName)
    Else
        MsgBox (PrinterName & vbCr & "Driver not found")
    End If
    Application.ActivePrinter = STDprinter
    
    '------------------------------------------------------------------------
End Sub

Still cannot work out how to set the filename. If anyone has an idea please help me!!!

 

[xenou]

Could you try the PrintOut method rather than using an XL4 macro?

ξ

VBA Help on Printout:

PrintOut Method
See AlsoApplies ToExampleSpecificsPrints the object.

expression.PrintOut(From, To, Copies, Preview, ActivePrinter, PrintToFile, Collate, PrToFileName)
expression Required. An expression that returns an object in the Applies To list.

From Optional Variant. The number of the page at which to start printing. If this argument is omitted, printing starts at the beginning.

To Optional Variant. The number of the last page to print. If this argument is omitted, printing ends with the last page.

Copies Optional Variant. The number of copies to print. If this argument is omitted, one copy is printed.

Preview Optional Variant. True to have Microsoft Excel invoke print preview before printing the object. False (or omitted) to print the object immediately.

ActivePrinter Optional Variant. Sets the name of the active printer.

PrintToFile Optional Variant. True to print to a file. If PrToFileName is not specified, Microsoft Excel prompts the user to enter the name of the output file.

Collate Optional Variant. True to collate multiple copies.

PrToFileName Optional Variant. If PrintToFile is set to True, this argument specifies the name of the file you want to print to.

Remarks
"Pages" in the descriptions of From and To refers to printed pages— not overall pages in the sheet or workbook.

Example
This example prints the active sheet.

ActiveSheet.PrintOut

maybe something like:

Dim MySheets As Variant, x As Variant
MySheets = Array("Sheet1","Sheet2","Sheet3")
For x = LBound(MySheets) to UBound(MySheets)
    Sheets(MySheets(x)).PrintOut PrintToFile:=True, PrToFileName:=(Sheets("Sheet").Range("A1").Value)
Next x

This strikes me as wrong in your code (so maybe your original code is fine except for this line):
Sheets("Sheet").Range("A1").Value
Should that be Sheet1, or each sheet in turn?

 

[BrendanDixon]

Oh wow now we are getting somewhere

It work except I had two problems. When it saved the file it saved it as a with no extension so I will have to set the file type.

And eventhough it printed the file name correctly I would like it to come up with the dialog window so that the used will be able to select the directory where he saves the document.

Oh and you were correct about the typo

 

[BrendanDixon]

Can anyone tell me how I can force the

.PrintOut PrintToFile:=True, PrToFileName:=(Sheets("Sheet").Range("A1").Value)</pre>

Does anyone know how I can force the print dialog window to come up ?

 

[xenou]

Do you need a folder path or the entire file path from a user?

If just a folder, check here:
http://www.mrexcel.com/forum/showthread.php?t=344682&highlight=folder+picker

If you need the whole filename from the user a similar process is possible (using Excel's VBA GetOpenFileName function).

 

[BrendanDixon]

mmmmmmm,


I am not sure how this will help me or how I would even integrate this into my code. Can anyone advise ?

 

[xenou]

Hi, just answer this question first:

Do you need a folder path or the entire file path from a user?

I don't mean to be curmudgeonly but your first post today (#4) sounds like you need a dynamic folder location from the user. And your second post today (#5) sounds like you want an entire filepath (folder + filename) from the user. Naturally, the code (and therefore a response) is different for each of these scenarios ... so I'll await clarification.

Xenou

 

[BrendanDixon]

Just the folder path.

Thanks Xenou

 

[BrendanDixon]

mmmmmm

Maybe I am getting confused. I want the user to be able to select the folder where he wants to save the file and then the saving macro will automatically assign the correct name generated from a cell. This is the code I have made so far last night.

Sub Print_Button_2()
Dim PrinterName As String
    Dim PortNumber As Integer
    Dim PrinterPort As String
    Dim PrinterFullName As String
    Dim PrinterFound As Boolean
    Dim STDprinter As String
    Dim lCount As Long
    '-------------------------------------------------------------------------
    STDprinter = Application.ActivePrinter
    GetFolderName = vbNullString
    PrinterName = "Microsoft XPS Document Writer"
    PrinterFound = False
    On Error Resume Next       ' SET ERROR TRAPPING
    '-------------------------------------------------------------------------
    '- LOOP Ne: NUMBERS
    For PortNumber = 0 To 12
        PrinterPort = "Ne" & Format(PortNumber, "00") & ":"
        PrinterFullName = PrinterName & PrinterNumber & " on " & PrinterPort
        '---------------------------------------------------------------------
        '- TRY TO SET ACTIVEPRINTER
        Application.ActivePrinter = PrinterFullName
        '---------------------------------------------------------------------
        '- IF ERROR TRY NEXT PRINTER
        If Err.Number = 0 Then
            Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
        With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
            For lCount = 1 To .SelectedItems.Count
            GetFolderName = .SelectedItems(lCount)
        Next lCount
        End With
            ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, PrintToFile:=True, PrToFileName:=(Sheets("Sheet1").Range("A1").Value & ".xps")
            PrinterFound = True
            Sheets(Array("Sheet1")).Select
            Exit For
        Else
            Err.Clear   ' clear for next error
        End If
        '---------------------------------------------------------------------
    Next PortNumber
    '-------------------------------------------------------------------------
    '- RESULT
    If PrinterFound Then
     '   MsgBox ("Successfully Saved With" & vbCr & PrinterFullName)
    Else
        MsgBox (PrinterName & vbCr & "Driver not found")
    End If
    Application.ActivePrinter = STDprinter
    '------------------------------------------------------------------------
End Sub

It works fine except that if the User Cancels the saving from the Folder picker Dialog then it still prints, where I would like it to cancel the printing operation and now I have another problem that if it cannot find the printer which I simulated by changing the name it does not comeup with the msgbox saying that the driver cannot be found.

Thanks