Question

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

冻结顶行
用黄色背景填写顶行
应用＆＃39;过滤器＆amp; sort＆＃39; ...

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

＆＃39; 9＆＃39;：下标超出范围

＆＃39; 1004＆＃39;方法＆＃39;范围＆＃39;对象＆＃39; _Global＆＃39;失败。

这些错误实际上并不一致。代码如下：

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 Access中限定外部Excel对象。下面的行需要由初始化的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

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

2 个答案: