在ms访问导出（VBA）后格式化Excel工作表

Question

我试图将MS Access（2013）查询中的多个查询导出到Excel（2013）中的多个工作表工作簿中。出口过程没有问题。此问题在导出后格式化工作表。每个工作表（5），我需要：

1. 冻结顶行
2. 填充排在前列有黄色背景
3. 应用 '过滤器&那种' ...

每个报告导出都有它自己的“部分”，所以我只会粘贴一个部分。 当码的格式化部分开始，我通常得到的错误，如运行时错误：

“9”：下标超出范围

对象的“1004”的方法“范围”“_Global '失败。

这些错误确实从来没有一致。代码如下：

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 
'************************************************* 

在此先感谢您的任何帮助。我已经连续3天对此感到震惊，而且我正处于尴尬的境地。 谢谢！

Answer 1

从根本上说，你是不是你的资格Excel对象是MS访问内部国外。下面的行需要通过您初始化的Excel对象进行限定。

电流：

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

正确：

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

VBA

考虑调整VBA模块完整的错误处理

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 

Answer 2

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 

将A2：G2更改为您想要的任何范围。

所有表：

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 

添加冻结顶行

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