Here is an example that does a lot of different things in an Excel spreadsheet.

Sub Build_XL_Report(strOutPut As String)
Const conLightGray As Long = 12632256
Const conLightBlue As Long = 16777164
Const conLightYellow As Long = 10092543

Dim xlApp As Object             'Application Object
Dim xlBook As Object            'Workbook Object
Dim xlSheet As Object           'Worksheet Object
Dim varGetFileName As Variant   'File Name with Full Path
Dim rstSCCB As Recordset        'Recordset to load data from
Dim rstItms As Recordset        'Recordset to load ITM Name in Header
Dim qdf As QueryDef             'Query def to load data
Dim lngItmCount As Long         'Number of ITMs in the RecordSet
Dim lngDetailCount As Long      'Number of Detail Data rows in the recordset
Dim intX As Integer             'Loop Counter
Dim strMonth As String          'Used to create a Short month name ie
January to Jan
Dim strCurrItm As String        'Hold the ITM Name to format Total cell
Dim lngRowCount As Long         'A loop counter that gives the current row
reference
Dim lngTotalPos As Long         'Used to format ITM Total cells
Dim strPrintArea As String      'Defines the print area for the sheet
Dim strTitleRows As String      'Defines the rows to print at the top of
each page
Dim strLeftRange As String      'Used to format range references
Dim strRightRange As String     'Used to format range references
Dim lngFirstDataRow As Long     'The first row with detail data
Dim lngLastDataRow As Long      'The last row with detail data
Dim blnExcelWasNotRunning As Boolean
Dim strDefaultDir               'Where to save spreadsheet
Dim strDefaultFileName          'Name to Save as
Dim lngFlags As Long            'Flags for common dialog
Dim strFilter As String         'File Display for Common Dialog
Dim strCurrMonth As String      'To create directory name for save
Dim strCurrYear As String      'To create directory name for save
Dim blnStopXl As Boolean        'Leave Open for Spreadsheet Version

   On Error GoTo Build_XL_Report_ERR
   
   DoCmd.Hourglass (True)
   Me.txtStatus = "Updating Queries"
   Me.txtStatus.Visible = True
'Fix the Queries so you dont have to be hand each month
   Call FixSql("qselsccbactual", "actual_res_export")
   Call FixSql("qselsccbactualtot", "actual_res_export")
   Me.txtStatus = "Getting ITM Data"
   Me.Repaint
   
'Set up the necessary objcts
   On Error Resume Next    ' Defer error trapping.
   Set xlApp = GetObject(, "Excel.Application")
   If Err.Number <> 0 Then
       blnExcelWasNotRunning = True
       Set xlApp = CreateObject("excel.application")
   Else
       DetectExcel
   End If
   Err.Clear    ' Clear Err object in case error occurred.
   On Error GoTo Build_XL_Report_ERR
   xlApp.DisplayAlerts = False
   xlApp.Interactive = False
   xlApp.ScreenUpdating = False
   Set xlBook = xlApp.Workbooks.Add
   
   Me.txtStatus = "Building Workbook"
   Me.Repaint
   
'Remove excess worksheets
   Do While xlBook.Worksheets.Count > 1
       xlApp.Worksheets(xlApp.Worksheets.Count).Delete
   Loop
   Set xlSheet = xlBook.ActiveSheet
   
'Build The Spreadsheet
'Build The Headers
   Me.txtStatus = "Creating Headers"
   Me.Repaint

   strMonth = Left(Me.cboPeriod.Column(1), 3)
   xlSheet.Name = Me.cboResource & " Hours " & strMonth & " YTD"
   With xlSheet
       .Cells(1, 1) = "ITM"
       .Cells(1, 2) = Me.txtCurrYear & _
           " Activity # Description"
       .Cells(1, 3) = "Budget " & Me.txtCurrYear
       .Cells(1, 4).Value = Me.txtCurrYear & " YTD Budget"
       .Cells(1, 5) = "Actuals YTD"
       .Cells(1, 6) = "Variance YTD"
       .Cells(1, 7) = "TO GO"
       .Cells(1, 8) = IIf(Me.cboPeriod >= 1, "JAN ACT", "JAN ETC")
       .Cells(1, 9) = IIf(Me.cboPeriod >= 2, "FEB ACT", "FEB ETC")
       .Cells(1, 10) = IIf(Me.cboPeriod >= 3, "MAR ACT", "MAR ETC")
       .Cells(1, 11) = IIf(Me.cboPeriod >= 4, "APR ACT", "APR ETC")
       .Cells(1, 12) = IIf(Me.cboPeriod >= 5, "MAY ACT", "MAY ETC")
       .Cells(1, 13) = IIf(Me.cboPeriod >= 6, "JUN ACT", "JUN ETC")
       .Cells(1, 14) = IIf(Me.cboPeriod >= 7, "JUL ACT", "JUL ETC")
       .Cells(1, 15) = IIf(Me.cboPeriod >= 8, "AUG ACT", "AUG ETC")
       .Cells(1, 16) = IIf(Me.cboPeriod >= 9, "SEP ACT", "SEP ETC")
       .Cells(1, 17) = IIf(Me.cboPeriod >= 10, "OCT ACT", "OCT ETC")
       .Cells(1, 18) = IIf(Me.cboPeriod >= 11, "NOV ACT", "NOV ETC")
       .Cells(1, 19) = IIf(Me.cboPeriod >= 12, "DEC ACT", "DEC ETC")
   End With
'Format Row 1
   With xlSheet
   For Each cell In xlSheet.Range("A1", "S1")
       cell.Font.Size = 10
       cell.Font.Name = "Arial"
       cell.Font.Bold = True
       cell.Interior.Color = conLightGray
       cell.HorizontalAlignment = xlHAlignCenter
       cell.WrapText = True
   Next
   .Cells(1, 2).HorizontalAlignment = xlHAlignLeft
   .Columns("A").ColumnWidth = 9
   .Columns("B").ColumnWidth = 39
   .Columns("C:S").ColumnWidth = 9
   .Rows(1).RowHeight = 25.5
   End With
   
'Set Up Recordset for ITM Header data
   Me.txtStatus = "Loading ITM Data"
   Me.Repaint

   Set qdf = CurrentDb.QueryDefs("qselSCCBhdr")
   qdf.Parameters(0) = Me.cboResource
   qdf.Parameters(1) = Me.cboPeriod
   Set rstItms = qdf.OpenRecordset(dbOpenSnapshot, dbReadOnly)
'Be sure there are records to process
   rstItms.MoveLast
   rstItms.MoveFirst
   lngItmCount = rstItms.RecordCount
   If lngItmCount = 0 Then
       MsgBox "No Data Found For This Report", vbInformation + vbOKOnly,
"Data Error"
       GoTo Build_XL_Report_Exit
   End If
   
'Load Header Data
   xlSheet.Cells(2, 1).CopyFromRecordset rstItms
   rstItms.Close
   Set rstItms = Nothing
   Set qdf = Nothing
   
'Format the ITM Name Cells
   Me.txtStatus = "Formatting Headers"
   Me.Repaint

   With xlSheet
   For Each cell In xlSheet.Range("A2", "A" & Trim(str(lngItmCount + 2)))
       cell.Font.Size = 10
       cell.Font.Name = "Arial"
       cell.Font.Bold = True
       cell.Interior.Color = conLightGray
       cell.HorizontalAlignment = xlHAlignLeft
       cell.WrapText = False
   Next
   End With
   
'Merge the ITM Cells
   For intX = 2 To lngItmCount + 2
       strLeftRange = "A" & Trim(str(intX)) & ":B" & Trim(str(intX))
       xlSheet.Range(strLeftRange).MergeCells = True
   Next intX
   
'Size the Blank Row
   xlSheet.Rows(lngItmCount + 3).RowHeight = 30
   
'Format Header Area and put in formulas
   With xlSheet
       For intX = 2 To lngItmCount + 1
           strLeftRange = "C" & Trim(str(intX))
           strRightRange = "S" & Trim(str(intX))
           For Each cell In xlSheet.Range(strLeftRange, strRightRange)
               cell.Font.Size = 10
               cell.Font.Name = "Arial"
               cell.Font.Bold = True
               cell.Interior.Color = conLightBlue
               cell.NumberFormat = "##,###,##0_);[Red](##,###,##0)"
           Next
       Next intX
'Do The Grand Total Row
           strLeftRange = "C" & Trim(str(intX))
           strRightRange = "S" & Trim(str(intX))
           For Each cell In xlSheet.Range(strLeftRange, strRightRange)
               cell.Font.Size = 10
               cell.Font.Name = "Arial"
               cell.Font.Bold = True
               cell.Interior.Color = conLightYellow
               cell.Formula = "= Grand"
               cell.NumberFormat = "##,###,##0_);[Red](##,###,##0)"
           Next
   End With

'Put Borders around the Header Area
   With xlSheet.Range("A1", "S" & Trim(str(lngItmCount + 2)))
       .Borders(xlTop).LineStyle = xlContinuous
       .Borders(xlTop).Weight = xlThin
       .Borders(xlBottom).LineStyle = xlContinuous
       .Borders(xlBottom).Weight = xlThin
       .Borders(xlLeft).LineStyle = xlContinuous
       .Borders(xlLeft).Weight = xlThin
       .Borders(xlRight).LineStyle = xlContinuous
       .Borders(xlRight).Weight = xlThin
   End With

'Add Total to ITM Names
   For intX = 2 To lngItmCount + 1
       xlSheet.Cells(intX, 1) = "Grand Total " & xlSheet.Cells(intX, 1)
   Next intX
   xlSheet.Cells(intX, 1) = "Grand Total " & _
       Me.cboResource & " HOURS"
   
'Copy the Header Row to the top of the Data Area
   xlSheet.Range("A1:S1").Copy _
       Destination:=xlSheet.Range("A" & Trim(str(intX + 2)))

'Load the Data
   Me.txtStatus = "Loading Detail Data"
   Me.Repaint
   
   Set qdf = CurrentDb.QueryDefs("qselSCCBrpt")
   qdf.Parameters(0) = Me.cboResource
   qdf.Parameters(1) = Me.cboPeriod
   Set rstSCCB = qdf.OpenRecordset(dbOpenSnapshot, dbReadOnly)
   xlSheet.Cells(intX + 3, 1).CopyFromRecordset rstSCCB
   lngDetailCount = rstSCCB.RecordCount
   rstSCCB.Close
   Set rstSCCB = Nothing
   Set qdf = Nothing
   
'Put in the SubTotals
   Me.txtStatus = "Creating Subtotals"
   Me.Repaint

   lngFirstDataRow = intX + 3
   lngLastDataRow = lngFirstDataRow + lngItmCount + lngDetailCount
   With xlSheet
       .Range(.Cells(lngFirstDataRow - 1, 1), _
           .Cells(lngLastDataRow, 19)).Subtotal groupBy:=1,
Function:=xlSum, _
           totalList:=Array(3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
16, 17, 18, 19)
   End With
   
'Create Formulas and range names
   For lngRowCount = lngFirstDataRow To lngLastDataRow
       lngTotalPos = InStr(xlSheet.Cells(lngRowCount, 1), "Total")
       If lngTotalPos = 0 Then 'Column S needs to be light yellow if not a
total row
           xlSheet.Cells(lngRowCount, 5).Interior.Color = conLightYellow
           xlSheet.Cells(lngRowCount, 6).Interior.Color = conLightYellow
       Else
           strCurrItm = Left(xlSheet.Cells(lngRowCount, 1), lngTotalPos - 2)
           With xlSheet
               .Range("C" & Trim(str(lngRowCount)) & ":S" & _
                   Trim(str(lngRowCount))).Name = strCurrItm
               .Range("A" & Trim(str(lngRowCount)) & ":S" & _
                   Trim(str(lngRowCount))).Interior.Color = conLightGray
           End With
       End If
   Next lngRowCount
   
'Clear the subtotals
   xlSheet.Range("A:S").Copy
   xlSheet.Range("A:S").PasteSpecial (xlPasteValues)
   xlSheet.Range("A:S").RemoveSubtotal
   xlSheet.Cells(1, 1).Select  'Removes the selection
   
'Set the Margins, Headers and Footers
   Me.txtStatus = "Formating Worksheet"
   Me.Repaint

   strPrintArea = "A1:S" & Trim(str(lngLastDataRow))
   strTitleRows = 1 & ":" & Trim(str(lngItmCount + 3))
   With xlSheet.PageSetup
       .Orientation = xlLandscape
       .Zoom = False
       .FitToPagesTall = False
       .FitToPagesWide = 1
       .CenterHeader = Me.txtCurrYear & " " & Me.cboResource _
           & " Hours " & strMonth & " YTD"
       .CenterFooter = "&F" & " " & "&D"
       .RightFooter = "&R Page &P of &N"
       .LeftMargin = xlApp.InchesToPoints(0)
       .RightMargin = xlApp.InchesToPoints(0)
       .TopMargin = xlApp.InchesToPoints(0.5)
       .BottomMargin = xlApp.InchesToPoints(0.5)
       .HeaderMargin = xlApp.InchesToPoints(0.25)
       .FooterMargin = xlApp.InchesToPoints(0.25)
       .PrintArea = strPrintArea
       .PrintTitleRows = xlSheet.Rows(strTitleRows).Address
   End With
       
'Format the Data Area
   With xlSheet
           strLeftRange = "A" & Trim(str(lngFirstDataRow))
           strRightRange = "S" & Trim(str(lngLastDataRow))
           For Each cell In xlSheet.Range(strLeftRange, strRightRange)
               cell.Font.Size = 10
               cell.Font.Name = "Arial"
               cell.Font.Bold = True
               cell.NumberFormat = "##,###,##0_);[Red](##,###,##0)"
           Next
   End With
   
'Put Borders around the Data Area
   With xlSheet.Range(strLeftRange, strRightRange)
       .Borders(xlTop).LineStyle = xlContinuous
       .Borders(xlTop).Weight = xlThin
       .Borders(xlBottom).LineStyle = xlContinuous
       .Borders(xlBottom).Weight = xlThin
       .Borders(xlLeft).LineStyle = xlContinuous
       .Borders(xlLeft).Weight = xlThin
       .Borders(xlRight).LineStyle = xlContinuous
       .Borders(xlRight).Weight = xlThin
   End With
   
'Spreadsheet is complete - Save it

'Set up default path and file
   strCurrYear = Me.txtCurrYear
   strCurrMonth = Me.cboPeriod.Column(1)
   strDefaultDir = "\\rsltx1-bm01\busmgmt\Vought " & strCurrYear & "\" &
strCurrYear _
   & " Actuals\" & strCurrMonth & "\"
   strDefaultFileName = Me.cboPeriod.Column(1) & _
       IIf([Forms]![frmsccbrpt]![cboResource] = "SEL", _
           " SCCB Report", " " & Me.cboResource & " Performance Report") &
".xls"
'Set filter to show only Excel spreadsheets
   strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.xls)")
'Flags Hides the Read Only Check and Only allow existing files
   lngFlags = ahtOFN_HIDEREADONLY Or ahtOFN_OVERWRITEPROMPT
'Call the Open File Dialog
   varGetFileName = ahtCommonFileOpenSave( _
       OpenFile:=False, _
       InitialDir:=strDefaultDir, _
       Filter:=strFilter, _
       Filename:=strDefaultFileName, _
       Flags:=lngFlags, _
       DialogTitle:="Save Report")
   If varGetFileName <> "" Then
       xlBook.SaveAs Filename:=varGetFileName
       Select Case strOutPut
           Case "Print"
               blnStopXl = True
               xlSheet.PrintOut Copies:=1, Collate:=True
           Case "PreView"
               blnStopXl = True
               xlApp.DisplayAlerts = True
               xlApp.Interactive = True
               xlApp.ScreenUpdating = True
               xlApp.Visible = True
               xlApp.WindowState = xlMaximized
               xlSheet.PrintPreview
               xlApp.Visible = False
           Case "XL"
               blnStopXl = False
               xlApp.DisplayAlerts = True
               xlApp.Interactive = True
               xlApp.ScreenUpdating = True
               xlApp.WindowState = xlMaximized
               xlApp.Visible = True
       End Select
   End If
'Time to Go
Build_XL_Report_Exit:
   Me.txtStatus.Visible = False
   Me.Repaint

   If blnStopXl Then
       xlBook.Close
       If blnExcelWasNotRunning = True Then
           xlApp.Quit
       Else
           xlApp.DisplayAlerts = True
           xlApp.Interactive = True
           xlApp.ScreenUpdating = True
       End If
       Set xlSheet = Nothing
       Set xlBook = Nothing
       Set xlApp = Nothing
   End If
   DoCmd.Hourglass (False)
   
   Exit Sub

Build_XL_Report_ERR:
   MsgBox (Err.Number & " - " & Err.Description)
   blnStopXl = True
   GoTo Build_XL_Report_Exit
End Sub