分享一个ppt链接对象路径批量更改的方法

jian1029

在制作ppt时, 经常会用到粘贴->选择性粘贴->工作表对象的功能来实现"当链接的表格数据更改时, PPT数据也同步更新", 此功能能很大程度上提高ppt的制作效率, 但当一个月完结, 需要将整套ppt+excel打包应用至新路径时, ppt链接的表格文件仍然为原来的路径, 这时则需要通过手工逐个更改源文件的功能来实现, 如果链接的表格非常多, 这就需要花费大量的时间来修改且容易出错, 因此可通过附件的方法来批量修改

jaffedream

感谢分享经验，可惜ppt没有alt+f9显示域代码那种功能，不然就方便多了。

lleong

很好，赞一个

yangcuiyu311

非常棒，谢谢

zbbbk

Search & Replace to change OLE link paths
Problem

Suppose you've got a lot of links in a PPT file or files and all the links point to a network share.

Then somebody comes along and installs a new server with a new name. Maybe they copy all of your files to the new server, but all of your links break because they point to \\OldServer\YourPath\ but the files are now on \\NewServer\YourPath\

Solution

This little macro will look for all of the OLE links in your presentation and change \\OldServer\ to \\NewServer\ (and if the folder names changed, it'll fix that too).

You'll need to edit the paths it searches for and replaces where indicated below.

Please run this only on a COPY of your important presentation files. Note that you won't see any changes until you save the presentation then re-open it and allow PowerPoint to update the links. We could force it to update immediately but that'd slow it down considerably.

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 sNewPath As String

    ' EDIT THIS TO REFLECT THE PATHS YOU WANT TO CHANGE
    ' Include just the portion of the path you want to change
    ' For example, to change links to reflect that files have moved from
    ' \\boss\p-drive\temp\*.* to
    ' \\boss\Q-drive\temp\*.*
    sOldPath = "\\boss\p-drive\"
    sNewPath = "\\boss\q-drive\"

    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 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

wqwqwqwqwq

很有用，先赞一个

lg8407

thanks for your sharing.

CM_Chan

非常感谢，这个成功解决了我的问题，谢谢！！

bygxg

你好，我有一个问题困扰了我很久，就是用vba按钮实现PPT里的表格，图表的数据更新，有实现的可能吗？谢谢！

借月光23

请问有EXCEL批量更改源文件的方法吗？