在ms access导出（VBA）后格式化Excel工作表_Excel_Vba_Ms Access

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

excel vba ms-access

在ms access导出（VBA）后格式化Excel工作表,excel,vba,ms-access,Excel,Vba,Ms Access,我正在尝试将MS Access（2013）查询中的多个查询导出到Excel（2013）中的多工作表工作簿中。出口过程没有问题。此问题是在导出后格式化工作表。对于每个工作表（5），我需要：冻结顶行用黄色背景填充顶行应用“筛选和排序” 每个报表导出都有自己的“部分”，因此，我只粘贴一个部分。当代码的格式化部分开始时，我通常会遇到错误，例如运行时错误： “9”：下标超出范围对象“\u Global”的“1004”方法“range”失败这些错误实际上从来都不是一致的。代码如下： Privat

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

冻结顶行

用黄色背景填充顶行

应用“筛选和排序”

每个报表导出都有自己的“部分”，因此，我只粘贴一个部分。当代码的格式化部分开始时，我通常会遇到错误，例如运行时错误：

“9”：下标超出范围

对象“\u Global”的“1004”方法“range”失败

这些错误实际上从来都不是一致的。代码如下：

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

提前感谢您的帮助。我已经在这上面敲了三天的脑袋，我已经不知所措了。谢谢

将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

从根本上说，您没有限定Excel对象在MS Access中是外来对象。下面的行需要由您初始化的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

谢谢你的帮助！在用上述示例替换旧代码时，我第一次尝试时出现了“下标超出范围错误”，然后第二次尝试完成了代码，但没有出现错误，但是工作表没有格式化。我可以让ms access唱歌，但是，我总是和excel针锋相对，所以，我真的很感谢你的输入…哦。。。你想让它在所有的电子表格中循环？该代码只作用于当前活动的工作表。哇！！！这太棒了！！！第二个代码段成功了！！有没有办法也冻结第一行？那就这样了！！谢谢你，布拉克斯！为你更新。我做错了什么。我得到一个错误，下标超出范围。。它在“工作表中的每个wkstrmain”输出TrMaint报告时失败，仅此而已。！。哇，从语法上讲，很难相信它仍然是VBA。。。Excel总是给我一些问题。谢谢大家，谢谢大家，谢谢大家。！。！！！

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