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

赞赏

微信赞赏支付宝赞赏

「赏不在多，觉得文章有用，就赞赏下吧！」

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

发表回复 取消回复

发表回复取消回复