Excel макрос для изменения местоположения файлов .cub, используемых сводными таблицами? (чтобы файлы .xls, зависящие от файлов .cub, были перемещены)

Question

Я часто использую Excel со сводными таблицами на основе .cub-файлов для анализа типа OLAP. Это замечательно, за исключением случаев, когда вы хотите переместить xls, и вы понимаете, что внутри него есть не относительная ссылка на расположение файла .cub. Как мы можем справиться с этим - т. Е. Удобно перемещать файлы xls, зависящие от .cub-файлов?

Лучший ответ, который я мог придумать, - это написать макрос, который обновляет ссылку на сводные таблицы на расположение файла .cub .... так что я поплю это в ответ.

Answer 1

Вот макрос, в котором я оказался. Ясно, что это делает некоторые предположения, которые могут быть неправильными для вас, например. он обновляет все сводные таблицы в книге, чтобы использовать тот же .cub-файл.

Он соединяется с соединениями Pivot Table книги, чтобы использовать .cub-файл с тем же именем, что и этот .xls-файл, в том же каталоге. Это предполагает, что 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