Excel宏来更改透视表使用的.cub文件的位置？(允许移动依赖于.cub文件的.xls文件)

Question

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

我能想到的最好的答案是编写一个宏来更新数据透视表对.cub文件location....so的引用，我将在答案中将其弹出。

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