Solved: Hyperlink TEXT not TextFrame, PPT help!!

[Tim@SU]

Hi, I'm killing myself trying to get VBA to hyperlink specific text within a TextFrame without hyperlinking the entire TextFrame! I'm using regular expressions to recognize specific patterns and provide a hyperlink based based on a generic URL. The code below, no matter how I try to revise it, links ALL the text within the range (shape).

Any help vastly appreciated!
THANKS!
-Tim


Here's the code:
For Each sld In Application.ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.HasTextFrame Then
Set txtRng = shp.TextFrame.TextRange
For Each m In re.Execute(txtRng)
fullURL = URL1 + m.Value + URL2
stop = m.Length
With shp.TextFrame.TextRange.Characters(m.FirstIndex, stop)
With .ActionSettings(ppMouseClick)
.Action = ppActionHyperlink
.Hyperlink.Address = fullURL
End With
End With
Next
End If
Next
Next

[TrippyTom]

Hi Tim,

For easier readability, please put your code in vba tags when you post. Also, your code has syntax errors according to the PowerPoint vba module. Are you sure this even works for you?

[Tim@SU]

Tom,

Thanks for the correction- accidentally grabbed from an older file. Here's my working (but not as desired!) tagged code.
Tim


[vba]
For Each sld In Application.ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.HasTextFrame Then
Set txtRng = shp.TextFrame.TextRange
For Each m In re.Execute(txtRng)
fullURL = URL1 + m.Value + URL2
With shp.TextFrame.TextRange.Characters(m.FirstIndex, m.Length)
With .ActionSettings(ppMouseClick)
.Action = ppActionHyperlink
.Hyperlink.Address = fullURL
End With
End With
Next
End If
Next
Next
[/vba]

[TrippyTom]

Hi Tim,
I'm still getting an error when it reaches this line:
[vba]For Each m In re.Execute(txtRng)[/vba]

What version of PPT are you using?

[Tim@SU]

Tom/All,

Yes I meant to remember to mention that. You need to add MS VBscript Regular Expressions v5.5 as a reference (and possibly download Windows Script 5.6, see msdn.microsoft.com/library/default.asp?url=/downloads/list/webdev.asp) if you want to see this run. If you want to see it work, you need to also type a number in the form of [1-3] alphas + [6] digits, i.e. j765890 into the presentation. To make it easy, here's the whole, complete function with declarations. It works with both versions of PPT (2000 & 2003) so far as I can tell.

Thanks very much,
Tim

[vba]

Sub timsfunction()

Dim re, m As Match
Dim Anchor As Object
Dim URL As String
Dim stopIndex As String
URL1 = "first part of my url"
URL2 = "second part of my url"
Set re = New RegExp
re.Pattern = "\w{1,3}\d{6}"
re.Global = True

For Each sld In Application.ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.HasTextFrame Then
Set txtRng = shp.TextFrame.TextRange
For Each m In re.Execute(txtRng)
fullURL = URL1 + m.Value + URL2
stopIndex = m.FirstIndex + m.Length
With shp.TextFrame.TextRange.Characters(m.FirstIndex, stopIndex)
'MsgBox (m.FirstIndex) 'use to verify indices are correct
'MsgBox (stopIndex)
With .ActionSettings(ppMouseClick)
.Action = ppActionHyperlink
.Hyperlink.TextToDisplay = m.Value
.Hyperlink.Address = fullURL
End With
End With
Next
End If
Next
Next

End Sub
[/vba]

[Tim@SU]

FYI: Short on patience for this one, be willing to offer a token of appreciation perhaps in exchange for the time if anyone can help me crack this one soon. Thanks...

[Andy Pope]

This following code works for me on a new ppt file.

[vba] With shp.TextFrame.TextRange.Characters(m.FirstIndex + 1, m.Length)
With .ActionSettings(ppMouseClick)
.Hyperlink.Address = fullURL
.Hyperlink.TextToDisplay = m.Value
End With
End With
[/vba]

BUT if I run your code example the problem of all characters being hyperlinked occurs. And worst still the above code no longer works properly.
In order to get it back to a working state I had to re create the textboxes.

[Tim@SU]

Hey looks good...thanks. Actually in hindsight I think I almost had it but couldn't tell because of the problem you mentioned about having to reset the textboxes. That's a bit tricky, caught me by surprise. Good call.

Tim