简单的方法来在Excel 2010中从VBA中更新function的重要性？
我想执行以下等效操作：
- Power Pivot> Tables>全部更新
- 数据透视表工具>数据>全部刷新
使用VBA。 所有表格都是包含在文件中的Excel表格。
Excel 2010中有这样一个简单的方法吗？
对于数据透视表更新，此代码将顺利运行：
ThisWorkbook.RefreshAll 或者，如果您的Excel版本太旧：
Dim Sheet as WorkSheet, _ Pivot as PivotTable For Each Sheet in ThisWorkbook.WorkSheets For Each Pivot in Sheet.PivotTables Pivot.RefreshTable Pivot.Update Next Sheet Next Pivot
在Excel 2013中，要刷新PowerPivot，这是一个简单的行ActiveWorkbook.Model.Refresh 。
在Excel 2010中，… FAR更复杂！ 这是汤姆·格里森（Tom Gleeson）提出的一般规范 ：
' ================================================== ' Test PowerPivot Refresh ' Developed By: Tom http://www.tomgleeson.ie ' Based on ideas by Marco Rosso, Chris Webb and Mark Stacey ' Dedicated to Bob Phillips a most impatient man ... ' Sep 2011 ' ' ======================================================= Option Explicit #If Win64 Then Public Declare PtrSafe Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long) #Else Public Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long) #End If Sub Refresh() Dim lDatabaseID As String Dim lDimensionID As String Dim lTable As String Dim RS As Object 'ADODB.Recordset Dim cnn As Object 'ADODB.Connection Dim mdx As String Dim xmla As String Dim cnnName As String Dim lSPID As String Dim lArray Dim i As Long On Error Resume Next ' For Excel 2013+ use connection name eg "Text InvoiceHeaders" ' Fr Excel 2010 use table name eg "InvoiceHeaders" lTable = [TableToRefresh] On Error GoTo 0 ' if Excel 2013 onwards: use Connections or Model refresh option via Object Model If Application.Version() > 14 Then ' "wake up" model ActiveWorkbook.Model.Initialize If lTable <> "" Then ActiveWorkbook.Connections(lTable).Refresh Else ActiveWorkbook.Model.Refresh End If ' For Excel 2013 that's all folks. Exit Sub End If cnnName = "PowerPivot Data" '1st "wake up" default PowerPivot Connection ActiveWorkbook.Connections(cnnName).Refresh '2nd fetch that ADO connection Set cnn = ActiveWorkbook.Connections(cnnName).OLEDBConnection.ADOConnection Set RS = CreateObject("ADODB.Recordset") ' then fetch the dimension ID if a single table specified ' FIX: need to exclude all rows where 2nd char = "$" mdx = "select table_id,rows_count from $System.discover_storage_tables where not mid(table_id,2,1) = '$' and not dimension_name = table_id and dimension_name='<<<<TABLE_ID>>>>'" If lTable <> "" Then mdx = Replace(mdx, "<<<<TABLE_ID>>>>", lTable) RS.Open mdx, cnn lDimensionID = fetchDIM(RS) RS.Close If lDimensionID = "" Then lDimensionID = lTable End If End If ' then fetch a valid SPID for this workbook mdx = "select session_spid from $system.discover_sessions" RS.Open mdx, cnn lSPID = fetchSPID(RS) If lSPID = "" Then MsgBox "Something wrong - cannot locate a SPID !" Exit Sub End If RS.Close 'Next get the current DatabaseID - changes each time the workbook is loaded mdx = "select distinct object_parent_path,object_id from $system.discover_object_activity" RS.Open mdx, cnn lArray = Split(lSPID, ",") For i = 0 To UBound(lArray) lDatabaseID = fetchDatabaseID(RS, CStr(lArray(i))) If lDatabaseID <> "" Then Exit For End If Next i If lDatabaseID = "" Then MsgBox "Something wrong - cannot locate DatabaseID - refesh PowerPivot connnection and try again !" Exit Sub End If RS.Close 'msgbox lDatabaseID If doXMLA(cnn, lDatabaseID, lDimensionID) = "OK" Then Sleep 1000 ' refresh connections and any related PTs ... ActiveWorkbook.Connections(cnnName).Refresh End If End Sub Private Function doXMLA(cnn, databaseID As String, Optional dimensionID As String = "", Optional timeout As Long = 30) Dim xmla As String Dim lRet Dim comm As Object ' ADODB.Command ' The XMLA Batch request If dimensionID = "" Then xmla = "<Batch xmlns=""http://schemas.microsoft.com/analysisservices/2003/engine""><Parallel><Process xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:ddl2=""http://schemas.microsoft.com/analysisservices/2003/engine/2"" xmlns:ddl2_2=""http://schemas.microsoft.com/analysisservices/2003/engine/2/2"" xmlns:ddl100_100=""http://schemas.microsoft.com/analysisservices/2008/engine/100/100""><Object><DatabaseID><<<DatabaseID>>></DatabaseID></Object><Type>ProcessFull</Type><WriteBackTableCreation>UseExisting</WriteBackTableCreation></Process></Parallel></Batch>" xmla = Replace(xmla, "<<<DatabaseID>>>", databaseID) Else xmla = "<Batch xmlns=""http://schemas.microsoft.com/analysisservices/2003/engine""><Parallel><Process xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:ddl2=""http://schemas.microsoft.com/analysisservices/2003/engine/2"" xmlns:ddl2_2=""http://schemas.microsoft.com/analysisservices/2003/engine/2/2"" xmlns:ddl100_100=""http://schemas.microsoft.com/analysisservices/2008/engine/100/100""><Object><DatabaseID><<<DatabaseID>>></DatabaseID><DimensionID><<<DimensionID>>></DimensionID></Object><Type>ProcessFull</Type><WriteBackTableCreation>UseExisting</WriteBackTableCreation></Process></Parallel></Batch>" xmla = Replace(xmla, "<<<DatabaseID>>>", databaseID) xmla = Replace(xmla, "<<<DimensionID>>>", dimensionID) End If Set comm = CreateObject("ADODB.command") comm.CommandTimeout = timeout comm.CommandText = xmla Set comm.ActiveConnection = cnn comm.Execute ' Make the request 'On Error Resume Next - comment out on error as most are not trappable within VBA !!! 'lRet = cnn.Execute(xmla) 'If Err Then Stop doXMLA = "OK" End Function Private Function fetchDatabaseID(ByVal inRS As Object, SPID As String) As String Dim i As Long Dim useThis As Boolean Dim lArray Dim lSID As String lSID = "Global.Sessions.SPID_" & SPID Do While Not inRS.EOF 'Debug.Print inRS.Fields(0) If CStr(inRS.Fields(0)) = lSID Then lArray = Split(CStr(inRS.Fields(1)), ".") On Error Resume Next If UBound(lArray) > 2 Then ' find database permission activity for this SPID to fetch DatabaseID If lArray(0) = "Permissions" And lArray(2) = "Databases" Then fetchDatabaseID = CStr(lArray(3)) Exit Function End If End If End If On Error GoTo 0 inRS.MoveNext Loop inRS.MoveFirst fetchDatabaseID = "" End Function Private Function fetchSPID(ByVal inRS As Object) As String Dim lSPID As String lSPID = "" Do While Not inRS.EOF If lSPID = "" Then lSPID = CStr(inRS.Fields(0).Value) Else lSPID = lSPID & "," & CStr(inRS.Fields(0).Value) End If inRS.MoveNext Loop fetchSPID = lSPID End Function Private Function fetchDIM(ByVal inRS As Object) As String Dim lArray Dim lSID As String If Not inRS.EOF Then fetchDIM = inRS.Fields(0) Else fetchDIM = "" End If End Function