Excel宏更改數據透視表使用的.cub文件的位置？ （允許移動依賴於.cub文件的.xls文件）

Question

我經常使用基於.cub文件的數據透視表的Excel進行OLAP類型分析。除了當你想移動xls並且你在內部意識到它有一個非相對引用到.cub文件的位置時，這是非常好的。我們如何處理這個問題 - 例如，移動依賴於.cub文件的xls文件是否方便？

我可以想出最好的答案是寫一個宏，更新數據透視表對'.cub文件位置的引用....所以我會彈出一個答案。

Answer 1

下面是我最終得到的宏。很顯然，這會產生一些可能不適合你的假設，例如它會更新工作簿中的所有數據透視表以使用相同的.cub文件。

它通過工作簿的數據透視表連接進行循環，以在同一目錄中使用與.xls文件同名的 .cub文件。這假設PivotCaches不使用LocalConnections - 檢查ActiveWorkbook.PivotCaches（1）.UseLocalConnection = False。

Sub UpdatePivotTableConnections() 
    Dim sNewCubeFile As String 
    sNewCubeFile = ActiveWorkbook.Path & Replace(ActiveWorkbook.Name, ".xls", ".cub", , , vbTextCompare) 

    Dim iPivotCount As Integer 
    Dim i As Integer 
    iPivotCount = ActiveWorkbook.PivotCaches.Count 

    ' Loop through all the pivot caches in this workbook. Use some 
    ' nasty string manipulation to update the connection. 
    For i = 1 To iPivotCount 
    With ActiveWorkbook.PivotCaches(i) 
     ' Determine which cub file the PivotCache is currently using 
     Dim sCurrentCubeFile As String 
     Dim iDataSourceStartPos As Integer 
     Dim iDataSourceEndPos As Integer 
     iDataSourceStartPos = InStr(1, .Connection, ";Data Source=", vbTextCompare) 
     If iDataSourceStartPos > 0 Then 
      iDataSourceStartPos = iDataSourceStartPos + Len(";Data Source=") 
      iDataSourceEndPos = InStr(iDataSourceStartPos, .Connection, ";", vbTextCompare) 
      sCurrentCubeFile = Mid(.Connection, iDataSourceStartPos, iDataSourceEndPos - iDataSourceStartPos) 

      ' If the PivotCache is using a different cub file then update the connection to use the new one. 
      If sCurrentCubeFile <> sNewCubeFile Then 
       .Connection = Left(.Connection, iDataSourceStartPos - 1) & sNewCubeFile & Right(.Connection, Len(.Connection) - iDataSourceEndPos + 1) 
      End If 
     End If 
    End With 
    Next i 
End Sub