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

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

0 голосов
/ 25 апреля 2010

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

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

1 Ответ

0 голосов
/ 25 апреля 2010

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