Sure. Here is the code I am working with.
' This code goes with a simple PowerPoint presentation:
' Slide 1: bullets
' Slide 2: title with a table containing at least one cell with text in it
' (mine is 2 rows by 5 columns with text in cell 1 only)
' Slide 3: title and bullets with one bullet containing the text "Slide 2" and
' one containint "Slide 4"
' Slide 4: anything
'
' Note that you may have to determine the actual slide IDs of your slides
and change the code
' to match them (first argument in the SubAddress property of the
Hyperlink object).
'
' I have seen PowerPoint 2007 crash multiple times while working on this
simple code
' trying to restore basic hyperlink functionality from VBA that I had in
Office 2003.
' This code goes with slide 2
Sub SeeSubAddressProblem()
' This works
ActivePresentation.Slides(2).Shapes(1).TextFrame.TextRange.ActionSettings(ppMouseClick).Hyperlink.Address = ""
ActivePresentation.Slides(2).Shapes(1).TextFrame.TextRange.ActionSettings(ppMouseClick).Hyperlink.SubAddress = "259,4,Slide 4"
' This doesn't!
ActivePresentation.Slides(2).Shapes(2).Table.Cell(1,
1).Shape.TextFrame.TextRange.ActionSettings(ppMouseClick).Hyperlink.Address =
""
ActivePresentation.Slides(2).Shapes(2).Table.Cell(1,
1).Shape.TextFrame.TextRange.ActionSettings(ppMouseClick).Hyperlink.SubAddress = "259,4,Slide 4"
End Sub
' This code goes with Slide 3
Sub SeeCharacterSubsetProblem()
' This works in Office 2003, and seems to sometimes work in Office 2007
Dim i As Integer
' Find the text "Slide 2" and make it a hyperlink to slide 2
i = InStr(1, ActivePresentation.Slides(3).Shapes(2).TextFrame.TextRange,
"Slide 2")
With
ActivePresentation.Slides(3).Shapes(2).TextFrame.TextRange.Characters(i,
Len("Slide 2")).ActionSettings(ppMouseClick).Hyperlink
.Address = ""
.SubAddress = "252,2,Slide 2"
End With
' Find the text "Slide 4" and make it a hyperlink to slide 4
i = InStr(1, ActivePresentation.Slides(3).Shapes(2).TextFrame.TextRange,
"Slide 4")
With
ActivePresentation.Slides(3).Shapes(2).TextFrame.TextRange.Characters(i,
Len("Slide 4")).ActionSettings(ppMouseClick).Hyperlink
.Address = ""
.SubAddress = "259,4,Slide 4"
End With
End Sub
' This code simply tries to remove any hyperlinks from the presentation.
' Run-time errors are encountered (that shouldn't be there) executing the
' Delete method on existing hyperlinks. Also after executing this code and
' while stopped at a trap, PowerPoint may crash (you get the "Do you want to
send an error report"
' dialog box).
Private Sub ClearAllHyperlinks()
Dim sl As Slide
Dim sh As Shape
Dim r As Integer
Dim c As Integer
For Each sl In ActivePresentation.Slides
For Each sh In sl.Shapes
'On Error Resume Next
If sh.HasTable Then
For r = 1 To sh.Table.Rows.Count
For c = 1 To sh.Table.Columns.Count
If Not sh.Table.Cell(r,
c).Shape.TextFrame.TextRange.ActionSettings(ppMouseClick).Hyperlink Is
Nothing Then
sh.Table.Cell(r,
c).Shape.TextFrame.TextRange.ActionSettings(ppMouseClick).Hyperlink.Delete
End If
Next c
Next r
End If
If sh.HasTextFrame Then
If Not
sh.TextFrame.TextRange.ActionSettings(ppMouseClick).Hyperlink Is Nothing Then
sh.TextFrame.TextRange.ActionSettings(ppMouseClick).Hyperlink.Delete
End If
End If
Next sh
Next sl
End Sub
