1
votes

I am trying to export multiple queries from an MS Access (2013) query into a multiple worksheet workbook in Excel (2013). The export process is no problem. This issue is formatting the worksheet(s) after the export. for each worksheet (5), I need to:

  1. Freeze top row
  2. fill in the top row with yellow background
  3. apply a 'filter&sort'...

Each report export has it's own 'section' so, I'll paste just one section. When the formatting portion of the code starts, I usually get errors such as run-time errors:

'9':Subscript out of range

'1004' Method 'range' of object '_Global' failed.

These errors are really never consistent. Code is below:

Private Sub cmdGeneralReportWithComments_Click()

Me.ReportProcessLb.Visible = True
Me.UpdateTablesLb.Visible = False

'Dim general variables to check that all fields are populated to make the         reports
Dim startdatevar As Date
Dim enddatevar As Date
Dim pathtotemplatevar As String
Dim savereporttovar As String
Dim reportnamevar As String
Dim alltogethernow As String

startdatevar = Me.txtStartDate
enddatevar = Me.txtEndDate
pathtotemplatevar = Nz(Me.txtBrowse, "")
savereporttovar = Me.txtToReport
reportnamevar = Me.txtNameTheReport
'alltogethernow = startdatevar + enddatevar + pathtotemplatevar +         savereporttovar + reportnamevar
'MsgBox alltogethernow

If startdatevar Like "" Or enddatevar Like "" Or pathtotemplatevar Like ""     Or savereporttovar Like "" Or reportnamevar Like "" Then

    MsgBox "The dates, report path's and a report path must be entered, please try again :)"

Else

'*************************************************
'Start Report PMCS
'*************************************************

'dim date values
Dim TheStartDate As Date
Dim TheEndDate As Date

'copy the template file and move it and rename it
Dim pathtotemplate As String
Dim pathtoreport As String

pathtotemplate = Me.txtBrowse
pathtoreport = Me.txtToReport

'output the Pmcs report
Dim outputFileName As String

'outputFileName = "C:\Users\travisanor1\Desktop\UTV\Reports\June2017  \SaveTest\GeneralReport_Template.xlsx"
outputFileName = pathtoreport & "\" & Me.txtNameTheReport
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12,   "GeneralReportWithComments_Pmcs", outputFileName, True

'Rename and format the worksheet
Dim xls     As Excel.Application
Dim wkb     As Excel.Workbook
Dim wks     As Excel.Worksheet

Set xls = New Excel.Application
Set wkb = xls.Workbooks.Open(pathtoreport & "\" & Me.txtNameTheReport)

'format
'filter sort on first row
Range("A1:Q1").AutoFilter

'Fill in first row
Rows("1:1").Select
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 65535
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With

'freeze top row
Rows("1:1").Select
With ActiveWindow
    .SplitColumn = 0
    .SplitRow = 1
End With
ActiveWindow.FreezePanes = True

' Set the name of the worksheet
Set wks = wkb.Worksheets("GeneralReportWithComments_Pmcs")
wks.Name = Me.txtStartDateTrim & " to " & Me.txtEndDateTrim & "_PMCS"

wkb.Close True
Set wks = Nothing
Set wkb = Nothing
xls.Quit
Set xls = Nothing
'*************************************************
'End PMCS report
'*************************************************

Thanks in advance for any assistance. I have been banging my head on this for 3 days now and I am at wits end. Thanks!!

2

2 Answers

1
votes

Fundamentally, you are not qualifying your Excel objects being foreign inside MS Access. Below lines need to be qualified by the Excel objects you initialize.

Current:

Range("A1:Q1").AutoFilter
Rows("1:1").Select
ActiveWindow.FreezePanes = True

Correct:

wks.Range("A1:Q1").AutoFilter            ' EXCEL WORKSHEET METHOD
wks.Rows("1:1").Select                   ' EXCEL WORKSHEET METHOD
xls.ActiveWindow.FreezePanes = True      ' EXCEL APPLICATION METHOD

VBA

Consider the adjusted VBA module complete with error handling

Public Sub ExportExcel()
On Error GoTo ErrHandle

    '... incorporate above code ...'
    Const outputFileName = pathtoreport & "\" & Me.txtNameTheReport

    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, _
          "GeneralReportWithComments_Pmcs", outputFileName, True

    'INITIALIZE EXCEL OBJECTS
    Dim xls     As Excel.Application
    Dim wkb     As Excel.Workbook
    Dim wks     As Excel.Worksheet

    Set xls = New Excel.Application
    Set wkb = xls.Workbooks.Open(outputFileName)
    Set wks = wkb.Worksheets("GeneralReportWithComments_Pmcs")

    ' FILTER/SORT TOP ROW
    wks.Range("A1:Q1").AutoFilter

    ' FILL FIRST ROW
    With wks.Rows("1:1").Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

    'FREEZE TOP ROW
    wks.Rows("1:1").Activate
    With xls.ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    xls.ActiveWindow.FreezePanes = True

    'RENAME WORKSHEET 
    '  (WARNING: SPECIAL CHARS LIKE / \ * [ ] : ? NOT ALLOWED IN SHEET NAMES)
    wks.Name = Me.txtStartDateTrim & " to " & Me.txtEndDateTrim & "_PMCS"

    MsgBox "Successfully exported and formatted workbook!", vbInformation, "OUTPUT"

ExitHandle:
    wkb.Close True
    Set wks = Nothing: Set wkb = Nothing
    xls.Quit
    Set xls = Nothing
    Exit Sub

ErrHandle:
    MsgBox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR"
    Resume ExitHandle
End Sub
0
votes
Public Sub FormatHeader()
  ActiveWindow.FreezePanes = True
  With ActiveSheet
    .Range("A2:G2").Interior.Color = vbYellow
    .Range("A2:G2").Font.Bold = True
    .Range("A2:G2").AutoFilter
    .Columns.AutoFit
  End With
End Sub

Change A2:G2 to whatever range you want.

for all sheets:

Public Sub FormatAllHeaders()
  Dim sh As Worksheet
  For Each sh In Worksheets
    ActiveWindow.FreezePanes = True
    With sh.Range("A1:G1")
      .Interior.Color = vbYellow
      .Font.Bold = True
      .AutoFilter
      .Columns.AutoFit
    End With
  Next
End Sub

Adding Freeze Top Row

Public Sub FormatAllHeaders()
  Dim sh As Worksheet
  For Each sh In Worksheets
    sh.Activate
    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
    End With
    ActiveWindow.FreezePanes = True
    With sh.Range("A1:G1")
      .Interior.Color = vbYellow
      .Font.Bold = True
      .AutoFilter
      .Columns.AutoFit
    End With
  Next
End Sub