XPS Automate file save as

[DFragnDragn]

This .XPS bloc works perfectly, but is currently running a manual save feature to the end user.
I've tried everything in my knowledge base and a several hours on the net.

I prefer to automate the save function and nest it with the balance of the wb dir files.
Any ideas greatly appreciated.

Option Explicit

Sub Ledger1()
    On Error Resume Next
    With ActiveSheet
        Columns("S:W").EntireColumn.Hidden = False
        Call PasteAll4Print
        On Error Resume Next
        Dim LastPrintRow As String
        Dim LastLine As Long
        Dim PrntCopy As String
        LastLine = Range("S350").End(xlUp).Row
        LastPrintRow = ("S1") & ":W" & LastLine
        PrntCopy = LastPrintRow
        With Worksheets("Sheet1").PageSetup
            .CenterHorizontally = True
            .PrintArea = PrntCopy
            .Orientation = xlPortrait
        End With
        Range(PrntCopy).PrintOut Copies:=1
        Application.CutCopyMode = False
    End With
    ActiveSheet.Range("M1").Select
    Columns("S:W").EntireColumn.Hidden = True
End Sub

 

[lhartono]

Just replace...

Range(PrntCopy).PrintOut Copies:=1

with

Range(PrntCopy).Select
Selection.ExportAsFixedFormat Type:=xlTypeXPS, _
Filename:=ActiveWorkbook.Path & "\PrintOut.xps", _
Quality:=xlQualityStandard, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, From:=1, To:=1, _
OpenAfterPublish:=True

 

[DFragnDragn]

lhartono, Thanks so much for the redirect.