Access VBA

Export Formatted Spreadsheet

Sub FormatXLfile(daPath As String, RptN As String)
    Dim XLapp   As Object
    Dim WB      As Object
    Dim WS      As Object
    Dim LastC   As Long
    Dim LastR   As Long
    Dim A       As Long
    Dim RptTp   As String
    
    Set XLapp = CreateObject("excel.Application")
    Set WB = XLapp.Workbooks.Open(daPath)
    Select Case RptN
        Case 1
            RptTp = " Paid Members"
        Case 2
            RptTp = " Not Paid and Not Dropped"
        Case 3
            RptTp = "Members for Printer"
        Case 4
            RptTp = "Digital Members"
        Case Else
            RptTp = "GPS Unknown"
    End Select
    XLapp.ScreenUpdating = True
    XLapp.Visible = True
    Set WS = WB.Sheets(1)
    WS.Activate 
    '-------------------------------------------
    WS.Cells(1, 1).Select
    LastC = WS.Cells(1, 2000).End(xlToLeft).Column
    LastR = WS.Range("A65000").End(xlUp).Row
    Debug.Print "Row: " & LastR & " Col: " & LastC
    With WS
        .Cells.Select
        .Cells.EntireColumn.AutoFit
        .Cells(1, 1).Select
        .Range(.Cells(1, 1), .Cells(1, LastC)).Select
        .Range(.Cells(1, 1), .Cells(1, LastC)).Font.Bold = True
        .Activate
         With .Range(.Cells(1, 1), .Cells(1, LastC)).Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = 49407
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    
    .Cells(1, 1).Select
    With WS.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
    End With
    With WB.ActiveSheet.PageSetup.PrintArea = "$A$2:" & .Cells(LastR, LastC).Address
        
     '----------------------- Print Setup -------------
    With WS.PageSetup
        .LeftHeader = ""
        .CenterHeader = RptTp
        .RightHeader = "&D  &T"
        .LeftFooter = "Confidential Information"
        .CenterFooter = ""
        .RightFooter = "Page &P of &N"
        .Zoom = False
        
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .LeftMargin = XLapp.InchesToPoints(0.2)
        .RightMargin = XLapp.InchesToPoints(0.2)
        .TopMargin = XLapp.InchesToPoints(0.7)
        .BottomMargin = XLapp.InchesToPoints(0.7)
        .HeaderMargin = XLapp.InchesToPoints(0.2)
        .FooterMargin = XLapp.InchesToPoints(0.2)
        .PrintHeadings = False
        .PrintGridlines = True
        .PrintQuality = 600
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter  'Legal ?
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False

    End With
 '   Stop       'Never got this to work
'         Range("B2").Select
'    ActiveWindow.FreezePanes = True
    End With
    End With
    WB.Save
    WB.Close
    Set WB = Nothing
    Set XLapp = Nothing
   
End Sub

Here is the code from the menu to export the Access data to Excel and call the function to make the spreadsheet pretty and ready to print.

Because this spreadsheet is usually 10-15 columns, I am considering an inputbox to ask if user wants to choose Letter or Legal size paper.

    CurPath = "C:\USERS\" & Environ("USERNAME") & "\Desktop\" & Format(Now(), "yyyymmdd") & "_UT_Digital_Export.xlsb"	Writes to desktop
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "qryMailing4Digital", CurPath, -1
    FormatXLfile CurPath, 4  Call the FormatXLFile routine shown above