用VBA修改所有透视表的数据源

Public Sub Update_PivotTables_Source()

Dim currWS As Worksheet

Dim currPT As PivotTable

Dim strName As String

Dim strMsg As String

Dim Res

On Error Resume Next

Filename = ThisWorkbook.Sheets("修改数据源").Cells(3, 3)

Workbooks.Open (Filename)

For Each currWS In Application.Worksheets

    For Each currPT In currWS.PivotTables

        currPT.SourceData = CutFilename(currPT.SourceData)

        currPT.RefreshTable

    Next currPT

Next currWS

MsgBox "所有透视表数据源更新完毕！"

End Sub

Private Function CutFilename(strSource As String) As String

Dim intPosition As Integer

Dim intStrLen As Integer

Dim blnFound As Boolean

Dim intFileStart As Integer

Dim intFileEnd As Integer

Dim chrCurr As String

strSource = Trim(strSource)

CutFilename = strSource

intPosition = 0: intStrLen = Len(strSource)

intFileStart = 0: intFileEnd = 0

blnFound = False

Do While (Not (blnFound) And (intPosition < intStrLen))

    intPosition = intPosition + 1

    chrCurr = Mid(strSource, intPosition, 1)

    Select Case chrCurr

        Case "["

            intFileStart = intPosition

        Case "]"

            intFileEnd = intPosition

            blnFound = True

    End Select

Loop

If blnFound Then CutFilename = Mid(strSource, 1, intFileStart - 1) & Mid(strSource, intFileEnd + 1, intStrLen)

End Function