目标:将我的数据透视表直接连接到源数据库表(在MS-ACCESS 2010中)。
状态:我可以通过VBA将WorkbookConnection
设置为数据库。
我也可以使用代码
PivotTable
WB.PivotCaches.Create(SourceType:=xlExternal, SourceData:=Conn) _
.CreatePivotTable TableDestination:=Worksheets("ManHours").Range("A1"), _
TableName:="OnePager"
但是,使用以下2个选项尝试Set PvtTbl
会产生运行时错误(1004):
选项1 :
Set PvtTbl = PvtCache.CreatePivotTable(TableDestination:=Worksheets("ManHours").Range("A1"), TableName:="OnePager")
选项2 :
Set PvtTbl = Worksheets("ManHours").PivotTables.Add(PivotCache:=PvtCache, TableDestination:=Worksheets("ManHours").Range("A1"), TableName:="OnePager")
我的代码
Option Explicit
Sub Dynamic_PivotTable()
Dim WB As Workbook
Dim WBConns As WorkbookConnection
Dim Conn As WorkbookConnection
Dim ConnString As String
Dim PvtTbl As PivotTable
Dim PvtCache As PivotCache
Set WB = Workbooks("DynamicPivot_Connection.xlsm") '<-- Workbook is open
' define ConnectionString
ConnString = "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=J:\PMO\Resource allocation\DB\Resource_DB.accdb;" & _
"Mode=Share Deny Write;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";" & _
"Jet OLEDB:Engine Type=6;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;" & _
"Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;" & _
"Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False;" & _
"Jet OLEDB:Bypass UserInfo Validation=False"
' loop through all Workbook connections and delete all except "Resource_DB"
For Each WBConns In WB.Connections
Select Case WBConns.Name
Case "Resource_DB"
Set Conn = WBConns
Case Else
WBConns.Delete
End Select
Next WBConns
If Conn Is Nothing Then
Set Conn = WB.Connections.Add("Resource_DB", "Resource DB Full Data Set", ConnString, "Select * from MergedDBTbl", 3)
End If
' set the Pivot Cache to update Workbook connection
Set PvtCache = WB.PivotCaches.Add(xlExternal, Conn)
' add this line in case the Pivot table doesn't exit >> first time running this Macro
On Error Resume Next
Set PvtTbl = Worksheets("ManHours").PivotTables("OnePager") ' check if "OnePager" Pivot Table already created (in past runs of this Macro)
On Error GoTo 0
If PvtTbl Is Nothing Then
' create a new Pivot Table in "ManHours" sheet, start from Cell A1
WB.PivotCaches.Create(SourceType:=xlExternal, SourceData:=Conn) _
.CreatePivotTable TableDestination:=Worksheets("ManHours").Range("A1"), TableName:="OnePager"
' create a new Pivot Table in "Pivot" sheet, start from Cell A1 ******* LINE BELOW PRODUCES AN ERROR ******
Set PvtTbl = Worksheets("ManHours").PivotTables.Add(PivotCache:=PvtCache, TableDestination:=Worksheets("ManHours").Range("A1"), TableName:="OnePager")
' ******* LINE BELOW PRODUCES AN ERROR ******
Set PvtTbl = PvtCache.CreatePivotTable(TableDestination:=Worksheets("ManHours").Range("A1"), TableName:="OnePager")
'Create the headings and row and column orientation and all of your other settings here
Else
' just refresh the Pivot cache with the updated Range (data in "ManHours" worksheet)
PvtTbl.ChangePivotCache PvtCache '<--- ALSO PRODUCES AN ERROR !
PvtTbl.RefreshTable
End If
End Sub
答案 0 :(得分:2)
您应该使用:
Set PvtCache = WB.PivotCaches.Create(xlExternal, Conn)
而不是:
Set PvtCache = WB.PivotCaches.Add(xlExternal, Conn)
要在工作簿打开时自动刷新数据透视表,请使用:
PvtCache.RefreshOnFileOpen = True