Have Access create a workbook and run a macro

[MemphisVBA]

I saw PVH's response to thread705-997479

and I am trying to do something very similar...

Here is the macro that I am trying to run once Access creates the workbook

Option Explicit

Sub FuelCard_Report()


'
    Cells.Select
    Cells.EntireColumn.AutoFit
    Cells.EntireRow.AutoFit
    Rows("1:1").Select
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Trans Date"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Trans Time"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Address"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "SL/ST"
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "Miles Driven"
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "Gal Purchased"
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "Price Per Gal"
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "Total Cost"
    Range("O1").Select
    ActiveCell.FormulaR1C1 = "Cost Per Mile"
    Range("A1:O1").Select
    Range("O1").Activate
    With Selection.Interior
        .ColorIndex = 33
        .Pattern = xlSolid
    End With

    Rows("2:2").Select
    ActiveWindow.FreezePanes = True
    Columns("D:D").Select
    Selection.NumberFormat = "[$-409]h:mm:ss AM/PM;@"
    Columns("H:H").Select
    Selection.NumberFormat = "0000"
    Range("A1:O198").Select
    Range("C10").Activate
    Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("C2") _
        , Order2:=xlAscending, Key3:=Range("D2"), Order3:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
        xlSortNormal
    Columns("A:A").EntireColumn.AutoFit
    Range("L3").Select
    Columns("L:L").ColumnWidth = 14.14
    Columns("J:J").ColumnWidth = 10.57
    Columns("D:D").ColumnWidth = 10.43
    Columns("M:M").ColumnWidth = 11.29
    Columns("N:N").ColumnWidth = 9.43
    Rows("1:1").Select
    Range("C1").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("I:I").ColumnWidth = 9.43
    Columns("L:L").ColumnWidth = 10.57

    
'make Consecutive days red (thanks PVH!)
    Dim r As Long
    Range("C:C").Font.ColorIndex = xlColorIndexAutomatic
    r = 3
    While Cells(r, "C") <> ""
      If Cells(r, "C") = Cells(r - 1, "C") Then
        Cells(r, "C").Font.ColorIndex = 3
        Cells(r - 1, "C").Font.ColorIndex = 3
      End If
      r = r + 1
    Wend
    
' subtotal by VIN
    Range("A1:O198").Select
    Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(13, 14, 15 _
        ), Replace:=True, PageBreaks:=False, SummaryBelowData:=True


    Range("A1").Select
    
End Sub

My report in Access is "Fuel Card" - which is driven by "qryFuelCardReport"

Any help or suggestions is greatly appreciated.

 

[MemphisVBA]

Well after some searching, I ran across thread705-993512 and a perfect solution by jbpez...

Here is my finished code:

Private Sub cmdMakeReport_Click()

Dim strReportName, strReportOut As String

    strReportName = "Report3"
    strReportOut = "Test.xls"

DoCmd.OutputTo acOutputReport, strReportName, acSpreadsheetTypeExcel8, strReportOut, False, ""


Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Dim xlAsheet As Object
Dim xlWindow As Object

    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Open(strReportOut)

With xlApp
    xlApp.Visible = False
    Set xlSheet = xlBook.Sheets(strReportName)

[COLOR=green]' ============== PASTE EXCEL MACRO CODE HERE ==============
 
 ' note - you will have to edit the Excel macro code:
 ' anywhere you see:
 ' "Cells." add "xlSheet." in front so it says "xlSheet.Cells......"
 ' the same goes for:
 
'xlSheet.Range.....
'xlSheet.Rows....
'xlWindow.FreezePanes....
'xlWindow.View....
 [/color]


    Set xlWindow = xlApp.ActiveWindow
    Set xlAsheet = xlApp.ActiveSheet

    xlSheet.Cells.Select
    xlSheet.Cells.EntireColumn.AutoFit
    xlSheet.Cells.EntireRow.AutoFit
    xlSheet.Rows("1:1").Select
    Selection.Font.Bold = True
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    xlSheet.Range("C1").Select
    ActiveCell.FormulaR1C1 = "Trans Date"
    xlSheet.Range("D1").Select
    ActiveCell.FormulaR1C1 = "Trans Time"
    xlSheet.Range("F1").Select
    ActiveCell.FormulaR1C1 = "Address"
    xlSheet.Range("H1").Select
    ActiveCell.FormulaR1C1 = "SL/ST"
    xlSheet.Range("J1").Select
    ActiveCell.FormulaR1C1 = "Miles Driven"
    xlSheet.Range("L1").Select
    ActiveCell.FormulaR1C1 = "Gal Purchased"
    xlSheet.Range("M1").Select
    ActiveCell.FormulaR1C1 = "Price Per Gal"
    xlSheet.Range("N1").Select
    ActiveCell.FormulaR1C1 = "Total Cost"
    xlSheet.Range("O1").Select
    ActiveCell.FormulaR1C1 = "Cost Per Mile"
    xlSheet.Range("A1:O1").Select
    xlSheet.Range("O1").Activate
    
    With Selection.Interior
        .ColorIndex = 33
        .Pattern = xlSolid
    End With
    
    xlSheet.Rows("2:2").Select
    ActiveWindow.FreezePanes = True
    Columns("D:D").Select
    Selection.NumberFormat = "[$-409]h:mm:ss AM/PM;@"
    Columns("H:H").Select
    Selection.NumberFormat = "0000"
    xlSheet.Range("A1:O198").Select
    xlSheet.Range("C10").Activate
    Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("C2") _
        , Order2:=xlAscending, Key3:=Range("D2"), Order3:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
        xlSortNormal
    Columns("A:A").EntireColumn.AutoFit
    xlSheet.Range("L3").Select
    Columns("L:L").ColumnWidth = 14.14
    Columns("J:J").ColumnWidth = 10.57
    Columns("D:D").ColumnWidth = 10.43
    Columns("M:M").ColumnWidth = 11.29
    Columns("N:N").ColumnWidth = 9.43
    Rows("1:1").Select
    Range("C1").Activate
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    Columns("I:I").ColumnWidth = 9.43
    Columns("L:L").ColumnWidth = 10.57

    
[COLOR=green]'make Consecutive days red (THANKS PHV!)[/color]
    Dim r As Long
    xlSheet.Range("C:C").Font.ColorIndex = xlColorIndexAutomatic
    r = 3
    While xlSheet.Cells(r, "C") <> ""
      If xlSheet.Cells(r, "C") = xlSheet.Cells(r - 1, "C") Then
        xlSheet.Cells(r, "C").Font.ColorIndex = 3
        xlSheet.Cells(r - 1, "C").Font.ColorIndex = 3
      End If
      r = r + 1
    Wend
    
[COLOR=green]' subtotal by VIN[/color]
    xlSheet.Range("A1:O198").Select
    Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(13, 14, 15 _
        ), Replace:=True, PageBreaks:=False, SummaryBelowData:=True


    xlAsheet.Range("A1").Select

[COLOR=green]' =============== END OF PASTED EXCEL MACRO CODE ============================[/color]

End With

    xlBook.Close savechanges:=True
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlAsheet = Nothing
    Set xlWindow = Nothing
    xlApp.Quit
    Set xlApp = Nothing

    MsgBox "Export and Format Complete!", , "Notice"

End Sub

- thanks