請問合併A及B兩個PPT檔案後,B檔案超連結的slide會跑掉?
我每個月有好幾個powerpoint檔案要合併時,都會遇到此問題,請問是超連結方式要修正,還是插入投影片方式錯誤(我的插入方式為'新增投影片'-->'重複使用投影片'-->'選取B.ppt'-->完成後B.ppt內的超連結全都跑掉。另外,我要如何才可利用巨集方式自動合併數個檔案?現在不能錄製巨集,學起來真是有點辛苦,請各位大大教教我! 好吧,我就先自問自答,PO一段目前的解結方式
Dim file(50) As String
Sub start()
Form1.Show
End Sub
Sub 合併投影片(file, fn)
Dim path As String
Dim inputFileName As String
Dim outputFileName As String
Dim slideNum As Integer
Dim x As Design '宣告 x 為 Design 物件.
Dim add, newadd As String
Dim hylk As Long
Dim page(50), pagetotal As Long
outputFileName = "allinone.pptx"
Set pptApp = New PowerPoint.Application
pptApp.Visible = msoTrue
Set pptOutput = pptApp.Presentations.Open("d:\" & outputFileName)
If pptOutput.Slides.Count = 0 Then
Set newSlide = pptOutput.Slides.add(1, ppLayoutBlank)
End If
For k = 1 To fn
Set pptInput = pptApp.Presentations.Open(file(k))
page(k) = pptInput.Slides.Count
pagetotal = pagetotal + page(k)
For j = 1 To pptInput.Slides.Count 'j為input檔案(k)的投影片數
If k = 1 Then '如為第1個input檔案,不需改變超連結位置,直接複製投影片及來源格式(含母片)即可
pptInput.Slides(j).Copy
Set x = pptInput.Slides(j).Design '將該投影片格式設定用x物件保存.
pptOutput.Slides.Paste(pptOutput.Slides.Count).Design = x
Else
pptInput.Slides(j).Copy
Set x = pptInput.Slides(j).Design '將該投影片格式設定用x物件保存.
pptOutput.Slides.Paste(pptOutput.Slides.Count).Design = x
M = pptOutput.Slides.Count
With pptOutput.Slides(M - 1)
For Each oHl In pptOutput.Slides(M - 1).Hyperlinks
With oHl
sSubaddress = .SubAddress
mystr = Replace(sSubaddress, ",", ".")
Value = Val(mystr)
ID1 = Int(Value) '取得subaddress中第1碼
strID2 = Replace(sSubaddress, ID1 & ",", "")
ID2 = Val(strID2) '取得subaddress中第2碼, 頁數
newID = ID2 + pagetotal - page(k)
newadd = Str(ID1) & "," & Str(newID) & ","
.SubAddress = newadd '修正超連結之頁碼
End With
Next
End With
End If
Next j
Next k
End Sub
不過有個問題還沒解決,就是如果都用超連結是OK,但是如果有的是用動作按鈕設定的方式,合併後仍無法正確連結,我想問題應是SUBADDRESS的編碼我還不是那麼清楚,尤其是第1碼 [b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=69116&ptid=12233]2#[/url] [i]hjwang123[/i] [/b]
再1次自問自答,原來subaddress第1碼為slideID,第2碼為slideInDex,只要slideID跟者一起改,超連結就再也不會跑掉了~
頁:
[1]