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

Question

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

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

Answer 1

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

Он перебирает соединения сводной таблицы книги, чтобы использовать файл.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