excel - Excel宏更改数据透视表使用的.cub文件的位置？（允许移动依赖于 .cub 文件的 .xls 文件）

Question

我经常使用 Excel 和基于 .cub 文件的数据透视表进行 OLAP 类型分析。这很好，除非您想移动 xls 并且您在内部意识到它对 .cub 文件的位置有非相对引用。我们如何应对这个问题 - 即方便移动依赖 .cub 文件的 xls 文件？

我能想出的最佳答案是编写一个宏来更新数据透视表对 .cub 文件位置的引用......所以我会在答案中弹出它。

Answer 1

这是我最终得到的宏。显然，这会做出一些可能不适合您的假设，例如，它会更新工作簿中的所有数据透视表以使用相同的 .cub 文件。

它遍历工作簿的数据透视表连接，以在同一目录中使用与此 .xls 文件同名的 .cub 文件。这假设 PivotCache 未使用 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