Creating a list of Hyperlinks in PPT deck

Desiderata · #1 10-14-2015, 01:43 PM

I'm using Office Professional 2013 and I found a macro to find hyperlinks in a PowerPoint deck- see below. It works well, and steps through the deck and provides a message box (attached).

I want it to provide a list of all the links in the deck instead of a message box for each link found. Is this reasonable?

Sub ShowMeTheHyperlinks()
' Lists the slide number, shape name and address
' of each hyperlink
Dim oSl As Slide
Dim oHl As Hyperlink
For Each oSl In ActivePresentation.Slides
For Each oHl In oSl.Hyperlinks
If oHl.Type = msoHyperlinkShape Then
MsgBox "HYPERLINK IN SHAPE" _

& vbCrLf _
& "Slide: " & vbTab & oSl.SlideIndex _
& vbCrLf _
& "Shape: " & oHl.Parent.Parent.Name _
& vbCrLf _
& "Address:" & vbTab & oHl.Address _
& vbCrLf _
& "SubAddress:" & vbTab & oHl.SubAddress
Else
' it's text
MsgBox "HYPERLINK IN TEXT" _
& vbCrLf _
& "Slide: " & vbTab & oSl.SlideIndex _
& vbCrLf _
& "Shape: " & oHl.Parent.Parent.Parent.Parent.Name _
& vbCrLf _
& "Address:" & vbTab & oHl.Address _
& vbCrLf _
& "SubAddress:" & vbTab & oHl.SubAddress
End If
Next ' hyperlink
Next ' Slide
End Sub

JohnWilson · #2 10-15-2015, 02:57 AM

I'm guessing you would like a printable list from Steve's code?

here's how to get that:

Code:

Sub ShowMeTheHyperlinksPrintable()
' Lists the slide number, shape name and address
' of each hyperlink
Dim oSl As Slide
Dim oHl As Hyperlink
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
strReport = strReport & "HYPERLINK IN TEXT" _
& vbCrLf _
& "Slide: " & vbTab & oSl.SlideIndex _
& vbCrLf _
& "Shape: " & oHl.Parent.Parent.Parent.Parent.Name _
& 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

Desiderata · #3 10-19-2015, 01:22 PM

Simply wonderful,
Thanks a million!
Dennis

Desiderata · #4 06-15-2016, 12:50 PM

Quote:

Originally Posted by JohnWilson

I'm guessing you would like a printable list from Steve's code?

here's how to get that:

Code:

Sub ShowMeTheHyperlinksPrintable()
' Lists the slide number, shape name and address
' of each hyperlink
Dim oSl As Slide
Dim oHl As Hyperlink
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
strReport = strReport & "HYPERLINK IN TEXT" _
& vbCrLf _
& "Slide: " & vbTab & oSl.SlideIndex _
& vbCrLf _
& "Shape: " & oHl.Parent.Parent.Parent.Parent.Name _
& 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

Hi John,
This was working, but we've recently upgraded to 2013. Not I get a run time error '445' The debugger says the problem is:
strReport = strReport & "HYPERLINK IN TEXT" _
& vbCrLf _
& "Slide: " & vbTab & oSl.SlideIndex _
& vbCrLf _
& "Shape: " & oHl.Parent.Parent.Parent.Parent.Name _
& vbCrLf _
& "Address:" & vbTab & oHl.Address _
& vbCrLf _
& "SubAddress:" & vbTab & oHl.SubAddress & vbCrLf

Here is the macro you provided earlier.

Sub ShowMeTheHyperlinksPrintable()
' Lists the slide number, shape name and address
' of each hyperlink
Dim oSl As Slide
Dim oHl As Hyperlink
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
strReport = strReport & "HYPERLINK IN TEXT" _
& vbCrLf _
& "Slide: " & vbTab & oSl.SlideIndex _
& vbCrLf _
& "Shape: " & oHl.Parent.Parent.Parent.Parent.Name _
& 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

Thanks!

JohnWilson · #5 06-16-2016, 01:06 AM

The macro works just fine in 2013 and 2016. 445 is Object does not support this action so I guess you have applied a hyperlink to an unsupported shape. I can't guess or imagine what that could be though.I know hyperlinks in Smart Art don't show but I don't get an error here just no text.

In essence though there's nothing wrong with the code but there is a problem with a particular presentation. Try it with a presentation with straightforward hyperlinks and then slowly add more.

JohnWilson · #6 06-16-2016, 02:37 AM

If you have links inside a table it will error. The "Shape" containing the link will be the cell and it does not have a name.

This code is clumsy but it might work.

Code:

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

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Need to put LOTS of pictures into ppt deck - 1 per slide	Mmitch799	PowerPoint	1	09-24-2015 04:38 AM
Master Slide Deck	creb1099	PowerPoint	2	11-20-2013 07:37 AM
How to keep hyperlinks when creating a table of contents	Abacaxi	Word	3	04-18-2012 12:24 AM
Mac: Problem creating hyperlinks	cpm	Word	4	04-13-2011 06:25 AM
Creating Hyperlinks	alicein1derville	Excel	5	02-08-2009 10:31 PM