office2010 ppt中引用excel中的图表,链接地址改变,需要逐个更改源文件,有没有批量修改源文件的办法

2025-03-09 22:51:51
推荐回答(2个)
回答1:

批量操作的话需要使用VBA程序。

可以参考这篇文章:http://www.pptfaq.com/FAQ00759_Search_-_Replace_to_change_OLE_link_paths.htm

我稍微完善了一下他的程序。他的程序原来只能更改插入的OLE对象,对于图表(Charts)的路径是不能更改的,而且每次使用都需要到VBA里去改代码。我这个不需要改代码了,只需要按Atl+F8,直接运行就行了。

Sub ChangeOLELinks()

' Note: this will only work in PPT 2000 and later

    Dim oSld As Slide
    Dim oSh As Shape
    Dim sOldPath As String
    Dim TpOldPath As String    'Temp Old Path, used to get file name without path
    Dim sNewPath As String
    Dim i As Integer, j As Integer
    
    'Get the old path of OLE objects
    For Each oSh In ActivePresentation.Slides(1).Shapes
        If oSh.Type = msoLinkedOLEObject Or oSh.Type = msoChart Then
            TpOldPath = oSh.LinkFormat.SourceFullName
            If TpOldPath <> "" Then Exit For
        End If
    Next

If TpOldPath = "" Then
        MsgBox ("Cannot find Linked OLE Object or Chart Object. Procedure terminated.")
        Exit Sub
    End If

    'Remove the FileName in the Path if the file is stored in LOCAL and uses back slash "\"
    For i = 1 To Len(TpOldPath)
        If InStr(i, TpOldPath, "\") > 0 Then
            i = InStr(i, TpOldPath, "\")
            j = i
        End If
    Next i
    
    If j > 0 Then
        TpOldPath = Left(TpOldPath, j - 1)
    Else
    'Remove the FileName in the Path if the file is stored in SERVER and uses forward slash "/"
        For i = 1 To Len(TpOldPath)
            If InStr(i, TpOldPath, "/") > 0 Then
                i = InStr(i, TpOldPath, "/")
                j = i
            End If
        Next i
        TpOldPath = Left(TpOldPath, j - 1)
    End If
   
    sOldPath = InputBox(prompt:="Please enter the OLD OLE Link Path", Default:=TpOldPath)
    sNewPath = InputBox("Please enter the NEW OLE Link Path", Default:=ActivePresentation.Path)

    On Error GoTo ErrorHandler

    For Each oSld In ActivePresentation.Slides
        For Each oSh In oSld.Shapes
            ' Change only linked OLE objects
            If oSh.Type = msoLinkedOLEObject Or oSh.Type = msoChart Then
                On Error Resume Next
                ' Verify that file exists
                If Len(Dir$(Replace(oSh.LinkFormat.SourceFullName, sOldPath, sNewPath))) > 0 Then
                     oSh.LinkFormat.SourceFullName = Replace(oSh.LinkFormat.SourceFullName, sOldPath, sNewPath)
                     
                Else
                      MsgBox ("File is missing; cannot relink to a file that isn't present")
                End If
                On Error GoTo ErrorHandler
             End If
        Next    ' shape
    Next    ' slide
    
MsgBox ("Done!")

NormalExit:
    Exit Sub
ErrorHandler:
    MsgBox ("Error " & Err.Number & vbCrLf & Err.Description)
    Resume NormalExit

End Sub

回答2:

任何文件最好不要使用链接文件,最好使用插入文件,就解决了文件可以移动的完整文件了。