欢迎光临 MathCai
我们一直在努力

office 2007 PPT 中电影链接相对路径的更改

在office 2007中如果ppt和电影文件(AVI等)不是存放在同一目录下的话,通过“插入-影片-文件中的影片”得到的将是影片的绝对路径。
因此将PPT和外部文件拷贝到别的电脑上或是哪怕是仅仅改变了位置,都会导致电影不能播放。
经过多方偿试,目前还没有发现直接地手动更改路径的办法。
下面给出用office 2007宏实现更改的例子:
Sub changeURL()
Dim slideNo As Integer
Dim shapeNo As Integer
Dim linkNo As Integer
Dim fullName As String
With Application.Presentations(1)
For slideNo = 1 To .Slides.Count
   For shapeNo = 1 To .Slides(slideNo).Shapes.Count
   With .Slides(slideNo).Shapes(shapeNo)
       On Error Resume Next
       If .MediaType = ppMediaTypeMovie Then
       fullName = .LinkFormat.SourceFullName
        ‘把绝对路径删去,只保留相对部分即可,此例中绝对路径是C:Documents and Settings。。。sample_image
       .LinkFormat.SourceFullName = Replace(fullName, “C:Documents and Settings。。。sample_image”, “”)
       End If
   End With
   Next
  
    ‘下面是更改超链接的例子,虽然其实超链接是可以手动改的
   For linkNo = 1 To .Slides(slideNo).Hyperlinks.Count
   With .Slides(slideNo).Hyperlinks(linkNo)
       On Error Resume Next
       fullName = .Address
       .Address = Replace(fullName, “C:Documents and Settings。。。”, “”)
   End With
   Next
Next
End With
End Sub
 
另一个有趣的做法是把所有的外部引用导出到文件中,然后在文件中改动后再导回到PPT:
导出链接到文件的SUB
Sub URL_to_File()
Dim avFilePath As String ‘文件路径
Dim lvIntFileNum As Integer ‘文件号
Dim lvContents As String
Dim slideNo As Integer
Dim shapeNo As Integer
Dim linkNo As Integer
Dim fullName As String
avFilePath = Application.Presentations(1).Path + “linkInfor.txt”  ‘取得当前路径加在文件名前
lvIntFileNum = FreeFile() ‘取一个空文件号
Open avFilePath For Output As #lvIntFileNum ‘打开文件
With Application.Presentations(1)
For slideNo = 1 To .Slides.Count
  
   For shapeNo = 1 To .Slides(slideNo).Shapes.Count
   With .Slides(slideNo).Shapes(shapeNo)
       On Error Resume Next
       If .MediaType = ppMediaTypeMovie Then
       fullName = .LinkFormat.SourceFullName
         ‘link contents , slide number , shape number , shape or link
       Print #lvIntFileNum, (fullName + “,” + CStr(slideNo) + “,” + CStr(shapeNo) + “,shape”)
        End If
   End With
   Next
  
   For linkNo = 1 To .Slides(slideNo).Hyperlinks.Count
   With .Slides(slideNo).Hyperlinks(linkNo)
       ‘On Error Resume Next
       fullName = .Address
      
       ‘link contents , slide number , shape number , shape or link
       Print #lvIntFileNum, (fullName + “,” + CStr(slideNo) + “,” + CStr(linkNo) + “,link”)
   End With
   Next
Next
End With
Close #lvIntFileNum ‘关文件
End Sub
 
读入PPT的SUB:
Sub URL_from_File()
Dim avFilePath As String ‘文件路径
Dim lvIntFileNum As Integer ‘文件号
Dim lvContents As String
Dim slideNo As Integer
Dim shapeNo As Integer
Dim stype As String
Dim fullName As String
Dim strArray() As String
avFilePath = Application.Presentations(1).Path + “linkInfor.txt”  ‘取得当前路径加在文件名前
lvIntFileNum = FreeFile() ‘取一个空文件号
Open avFilePath For Input As #lvIntFileNum
With Application.Presentations(1)
    Do While Not EOF(lvIntFileNum)
       Line Input #lvIntFileNum, lvContents
       strArray = Split(lvContents, “,”)
       fullName = strArray(0)
       slideNo = Val(strArray(1))
       shapeNo = Val(strArray(2))
       stype = strArray(3)
       On Error Resume Next
       If StrComp(stype, “shape”) = 0 Then
       .Slides(slideNo).Shapes(shapeNo).LinkFormat.SourceFullName = fullName
       Else
       .Slides(slideNo).Hyperlinks(shapeNo).Address = fullName
       End If
   Loop
  
  
End With
Close #lvIntFileNum
End Sub
From:http://blog.sina.com.cn/s/blog_77e53fb20100pt4o.html
未经允许不得转载:MathCai » office 2007 PPT 中电影链接相对路径的更改
分享到: 更多 (0)

评论 抢沙发

  • 昵称 (必填)
  • 邮箱 (必填)
  • 网址