设为首页收藏本站

嘻皮客娱乐学习网

 找回密码
 中文注册
搜索
开启左侧

[OFFICE] 应用宏批量更改PPT中外部链接的路径

[复制链接]
发表于 2020-7-31 17:29:15 | 显示全部楼层 |阅读模式
office2010 ppt中引用excel中的图表,拷贝到别的电脑后,链接地址改变,需要逐个更改源文件,可以在PPT中应用宏来实现。
可以更改插入的OLE对象,图表(Charts)的路径。
  1. Sub ChangeOLELinks()

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

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

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

  21.     'Remove the FileName in the Path if the file is stored in LOCAL and uses back slash ""
  22.     For i = 1 To Len(TpOldPath)
  23.         If InStr(i, TpOldPath, "") > 0 Then
  24.             i = InStr(i, TpOldPath, "")
  25.             j = i
  26.         End If
  27.     Next i
  28.      
  29.     If j > 0 Then
  30.         TpOldPath = Left(TpOldPath, j - 1)
  31.     Else
  32.     'Remove the FileName in the Path if the file is stored in SERVER and uses forward slash "/"
  33.         For i = 1 To Len(TpOldPath)
  34.             If InStr(i, TpOldPath, "/") > 0 Then
  35.                 i = InStr(i, TpOldPath, "/")
  36.                 j = i
  37.             End If
  38.         Next i
  39.         TpOldPath = Left(TpOldPath, j - 1)
  40.     End If
  41.    
  42.     sOldPath = InputBox(prompt:="Please enter the OLD OLE Link Path", Default:=TpOldPath)
  43.     sNewPath = InputBox("Please enter the NEW OLE Link Path", Default:=ActivePresentation.Path)

  44.     On Error GoTo ErrorHandler

  45.     For Each oSld In ActivePresentation.Slides
  46.         For Each oSh In oSld.Shapes
  47.             ' Change only linked OLE objects
  48.             If oSh.Type = msoLinkedOLEObject Or oSh.Type = msoChart Then
  49.                 On Error Resume Next
  50.                 ' Verify that file exists
  51.                 If Len(Dir$(Replace(oSh.LinkFormat.SourceFullName, sOldPath, sNewPath))) > 0 Then
  52.                      oSh.LinkFormat.SourceFullName = Replace(oSh.LinkFormat.SourceFullName, sOldPath, sNewPath)
  53.                      
  54.                 Else
  55.                       MsgBox ("File is missing; cannot relink to a file that isn't present")
  56.                 End If
  57.                 On Error GoTo ErrorHandler
  58.              End If
  59.         Next    ' shape
  60.     Next    ' slide
  61.      
  62. MsgBox ("Done!")

  63. NormalExit:
  64.     Exit Sub
  65. ErrorHandler:
  66.     MsgBox ("Error " & Err.Number & vbCrLf & Err.Description)
  67.     Resume NormalExit

  68. End Sub
复制代码
回复

使用道具 举报

精彩推荐

小黑屋|手机版|嘻皮客网 ( 京ICP备10218169号|京公网安备11010802013797  

GMT+8, 2020-8-10 14:02 , Processed in 0.264548 second(s), 10 queries , Gzip On, File On.

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表