2016-10-12 9 views
2

は、だから私は、私はプレゼンテーション内のハイパーリンクのすべての部分を変更するには、次のコードを使用しています大規模なPowerPointプレゼンテーションを持っている(相対ではなく絶対参照を使用するようにファイルパスの一部を削除する):パワーポイントからダイナミックレンジへのハイパーリンクを保存しますか?

Dim oSl As Slide 
Dim oHl As Hyperlink 
Dim sSearchFor As String 
Dim sReplaceWith As String 
Dim oSh As Shape 

sSearchFor = InputBox("What text should I search for?", "Search for ...") 
If sSearchFor = "" Then 
    Exit Sub 
End If 

sReplaceWith = InputBox("What text should I replace" & vbCrLf _ 
    & sSearchFor & vbCrLf _ 
    & "with?", "Replace with ...") 
'If sReplaceWith = "" Then 
' Exit Sub 
'End If 

On Error Resume Next 

For Each oSl In ActivePresentation.Slides 

    For Each oHl In oSl.Hyperlinks 
     oHl.Address = Replace(oHl.Address, sSearchFor, sReplaceWith) 
     oHl.SubAddress = Replace(oHl.SubAddress, sSearchFor, sReplaceWith) 
    Next ' hyperlink 

    For Each oSh In oSl.Shapes 
     If oSh.Type = msoLinkedOLEObject _ 
     Or oSh.Type = msoMedia Then 
      oSh.LinkFormat.SourceFullName = _ 
       Replace(oSh.LinkFormat.SourceFullName, _ 
       sSearchFor, sReplaceWith) 
     End If 
    Next 

Next ' slide 

QAにしたいことは、オリジナルのハイパーリンクと変更されたハイパーリンクをExcelのシートに並べて表示し、元のリンクと新しいリンクを比較してすべてが正常に動作していることを確認することです。

ここに私の最初の投稿は、私は多くの喜びは、多くの喜んで助けてくれました!

おかげ

ジェームズ

答えて

1

このことができます作品のようなものがありますが、Microsoft Excelの参照に

Dim oSl As Slide 
Dim oHl As Hyperlink 
Dim sSearchFor As String 
Dim sReplaceWith As String 
Dim oSh As Shape 
Dim wk As Workbook 
Dim ws As Worksheet 
Dim i As Double 

Set wk = Workbooks.Add 
Set ws = wk.Worksheets(1) 

ws.Cells(1, 1).Value = "original" 
ws.Cells(1, 2).Value = "modified" 
i = 2 

sSearchFor = InputBox("What text should I search for?", "Search for ...") 
If sSearchFor = "" Then 
    Exit Sub 
End If 

sReplaceWith = InputBox("What text should I replace" & vbCrLf _ 
    & sSearchFor & vbCrLf _ 
    & "with?", "Replace with ...") 
'If sReplaceWith = "" Then 
' Exit Sub 
'End If 

On Error Resume Next 

For Each oSl In ActivePresentation.Slides 

    For Each oHl In oSl.Hyperlinks 
     ws.Cells(i, 1).Value = oH1.Address 'original 
     oHl.Address = Replace(oHl.Address, sSearchFor, sReplaceWith) 'modification 
     ws.Cells(i, 2).Value = oH1.Address 'modified 
     i = i + 1 
     oHl.SubAddress = Replace(oHl.SubAddress, sSearchFor, sReplaceWith) 
    Next ' hyperlink 

    For Each oSh In oSl.Shapes 
     If oSh.Type = msoLinkedOLEObject _ 
     Or oSh.Type = msoMedia Then 
      oSh.LinkFormat.SourceFullName = _ 
       Replace(oSh.LinkFormat.SourceFullName, _ 
       sSearchFor, sReplaceWith) 
     End If 
    Next 

Next ' slide 
を追加する必要があります
関連する問題