在 Access VBA 中的 xlsx 文件中进行透视

Question

“c:”中有一些 xlsx 文件，是从 Microsoft Access 表中导出的。大约有 4 个文件，其列数和名称相同，但数据不同。

当代码开始运行时，它使第一个 xlsx 正确旋转没有问题，但第二次迭代在这里导致错误：

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    fileName, Version:=6).CreatePivotTable TableDestination:= _
    "Sheet1!R3C1", TableName:="PivotTable1", DefaultVersion:=6

错误：运行时错误“91”：对象变量或未设置块变量

在Sheets、ActiveWorkbook 等之前我已经尝试过使用“myWorkbook”，但是没有用或者我没有正确使用。

所有 Excel 文件都应该有数据透视表。

Sub test()
    Dim strF As String, strP As String
    Dim wb As Workbook
    Dim ws As Worksheet


    'Edit this declaration to your folder name
    strP = "c:\" 'change for the path of your folder


    strF = Dir(strP & "\*.xls*") 'Change as required



    Do While strF <> vbNullString
        'MsgBox strP & "\" & strF
        createPivot strP & "\" & strF, strF
        strF = Dir()
    Loop    
End Sub


Sub createPivot(path As String, fileName As String)

    fileName = Replace(fileName, ".xlsx", "")
    Dim appExcel As Excel.Application
    Dim myWorkbook As Excel.Workbook

    Set appExcel = CreateObject("Excel.Application")
    Set myWorkbook = appExcel.Workbooks.Open(path)
    appExcel.Visible = True

    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        fileName, Version:=6).CreatePivotTable TableDestination:= _
        "Sheet1!R3C1", TableName:="PivotTable1", DefaultVersion:=6
    Sheets("Sheet1").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Field1")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Field2")
        .Orientation = xlPageField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Field3")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("FieldN"), "Sum of FieldN", xlSum
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Field+1")
        .Orientation = xlRowField
        .Position = 1
    End With

    myWorkbook.Save
    myWorkbook.Close

    appExcel.Quit

    Set myWorkbook = Nothing
    Set appExcel = Nothing
Exit Sub
End Sub

Answer 1

您的数据透视缓存的源范围可能有误。您为此使用“文件名”（它是与文件名相对应的命名范围，在每个工作簿中都有效吗？）。

我建议如下：

• 按对象构建代码对象：工作簿、数据透视缓存、工作表、数据透视表、数据透视字段……
• 当您使用两个应用程序时：非常清楚地声明几乎每个变量，例如Excel.Workbook
• avoid selecting or activating anything

---

Sub test()
    Dim strF As String, strP As String
    Dim wb As Excel.Workbook
    Dim ws As Excel.Worksheet

    'Edit this declaration to your folder name
    strP = "c:\users\..." 'change for the path of your folder

    strF = Dir(strP & "\*.xls*") 'Change as required

    Do While strF <> vbNullString
        'MsgBox strP & "\" & strF
        createPivot strP & "\" & strF, strF
        strF = Dir()
    Loop
End Sub


Sub createPivot(path As String, fileName As String)
    Dim appExcel As Excel.Application
    Dim myWorkbook As Excel.Workbook
    Dim myWorksheet As Excel.Worksheet
    Dim pc As Excel.PivotCache
    Dim pt As Excel.PivotTable

    fileName = Replace(fileName, ".xlsx", "")

    On Error Resume Next
    Set appExcel = GetObject(, "Excel.Application")
    On Error GoTo 0
    If appExcel Is Nothing Then Set appExcel = CreateObject("Excel.Application")
    appExcel.Visible = True

    Set myWorkbook = appExcel.Workbooks.Open(path)

    Set pc = myWorkbook.PivotCaches.Create( _
        SourceType:=xlDatabase, _
        SourceData:=myWorkbook.Sheets(1).UsedRange) ' this might be adapted

    Set myWorksheet = myWorkbook.Sheets.Add
    Set pt = pc.CreatePivotTable( _
        TableDestination:=myWorksheet.Range("A3"), _
        TableName:="PivotTable1")

    With pt.PivotFields("Field1")
        .Orientation = xlPageField
        .Position = 1
    End With

    With pt.PivotFields("Field2")
        .Orientation = xlPageField
        .Position = 1
    End With

    With pt.PivotFields("Field3")
        .Orientation = xlColumnField
    End With

    With pt.PivotFields("FieldN")
        .Orientation = xlDataField
        .Function = xlSum
        .Name = "Sum of FieldN"
    End With

    With pt.PivotFields("Field+1")
        .Orientation = xlRowField
        .Position = 1
    End With

    myWorkbook.Save
    myWorkbook.Close
    Set myWorkbook = Nothing

    appExcel.Quit
    Set appExcel = Nothing
End Sub

Answer 2

您可以使用早期绑定或后期绑定从 Access 控制 Excel。

' EARLY BINDING
Option Compare Database
Option Explicit ' Use this to make sure your variables are defined

' One way to be able to use these objects throughout the Module is to Declare them
' Here and not in a Sub

Private objExcel As Excel.Application
Private xlWB As Excel.Workbook
Private xlWS As Excel.Worksheet

Sub Rep()

Dim strFile As String

strFile = "C:\Users\Excel\Desktop\YourExcelFile.xls"

' Opens Excel and makes it Visible
Set objExcel = New Excel.Application
objExcel.Visible = True

'Opens up the Workbook
Set xlWB = objExcel.Workbooks.Open(strFile)

'Sets the Workseet to the last active sheet - Better to use the commented version and use the name of the sheet.
Set xlWS = xlWB.ActiveSheet
'Set xlWS = xlWB("Sheet2")

With xlWS ' You are now working with the Named file and the named worksheet


End With

'Do Close and Cleanup
End Sub


 
' LATE BINDING
Sub ControlExcelFromAccess()

' No reference to a type library is needed to use late binding.
' As long as the object supports IDispatch, the method can
' be dynamically located and invoked at run-time.

' Declare the object as a late-bound object
  Dim oExcel As Object
  Dim strFile As String

  strFile = "C:\Users\Excel\Desktop\YourExcelFile.xls"

  Set oExcel = CreateObject("Excel.Application")

' The Visible property is called via IDispatch
  oExcel.Visible = True

  Set xlWB = oExcel.Workbooks.Open(strFile)

'Call code here . . .

Set oExcel = Nothing

End Sub