在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