Sub ShowMeTheHyperlinksPrintable()
' Lists the slide number, shape name and address
' of each hyperlink
Dim oSl As Slide
Dim oHl As Hyperlink
Dim oshp As Shape
Dim strName As String
Dim strReport As String
Dim ifilenum As Integer
Dim filepath As String
filepath = Environ("USERPROFILE") & "\Desktop\links.txt"
For Each oSl In ActivePresentation.Slides
For Each oHl In oSl.Hyperlinks
If oHl.Type = msoHyperlinkShape Then
strReport = strReport & "HYPERLINK IN SHAPE" _
& vbCrLf _
& "Slide: " & vbTab & oSl.SlideIndex _
& vbCrLf _
& "Shape: " & oHl.Parent.Parent.Name _
& vbCrLf _
& "Address:" & vbTab & oHl.Address _
& vbCrLf _
& "SubAddress:" & vbTab & oHl.SubAddress & vbCrLf
Else
' it's text
On Error Resume Next
Err.Clear
strName = oHl.Parent.Parent.Parent.Parent.Name
If strName = "" Then
oHl.Parent.Parent.Parent.Parent.Select
strName = ActiveWindow.Selection.ShapeRange(1).Name
End If
strReport = strReport & "HYPERLINK IN TEXT" _
& vbCrLf _
& "Slide: " & vbTab & oSl.SlideIndex _
& vbCrLf _
& "Shape: " & strName _
& vbCrLf _
& "Address:" & vbTab & oHl.Address _
& vbCrLf _
& "SubAddress:" & vbTab & oHl.SubAddress & vbCrLf
End If
Next ' hyperlink
Next ' Slide
ifilenum = FreeFile
Open filepath For Output As ifilenum
Print #ifilenum, strReport
Close ifilenum
Call Shell("Notepad.exe " & filepath, vbNormalNoFocus)
End Sub