Create Powerpoint shape with hyperlink and text-CodePudding

I am creating an index in powerpoint with links to other slides and it works fine to create the shapes and hyperlink attached to the shape, but I cannot get it to add text into the shape. At the moment I do it manually after the shape is created.

I have seen the method below but I get an error on the TexttoDisplay. What am I doing wrong? Quite happy to use TextFrames if I can add the hyperlink to the frame rather than the text.

Sub CreateIndx()


' Create hyperlink to slide 2

Set pp = ActivePresentation


Set sh = pp.Slides(1).Shapes.AddShape(Type:=msoShapeRectangle, Left:=50, Top:=50, Width:=215, Height:=30)
With sh.ActionSettings(ppMouseClick)
.Action = ppActionHyperlink
.Hyperlink.Address = "..\War Memorial Slides\War Memorial Slides - Badlesmere to Elmley.pptx"
.Hyperlink.SubAddress = "1. Powerpoint Presentation"
        .TextToDisplay = "My Name"

End With

End Sub

CodePudding user response：

Change Text:

Option Explicit
Sub CreateIndx()
    ' Create hyperlink to slide 2
    
    Dim pp
    Dim sh
    
    Set pp = ActivePresentation
    
    Set sh = pp.Slides(1).Shapes.AddShape(Type:=msoShapeRectangle, Left:=50, Top:=50, Width:=215, Height:=30)
    With sh.ActionSettings(ppMouseClick)
        .Action = ppActionHyperlink
        .Hyperlink.Address = "..\War Memorial Slides\War Memorial Slides - Badlesmere to Elmley.pptx"
        .Hyperlink.SubAddress = "1. Powerpoint Presentation"
    End With
    
    sh.TextFrame.TextRange.Text = "Test" '<<< Your text here

End Sub

CodePudding user response：

The other replies will solve the problem for you if you want text in the shape that you've created. If instead you want to add a tool tip ... the little hint text that appears when you hover over the hyperlinked shape ... use this:

Sub CreateIndx()
' Create hyperlink to slide 2

' I'm a believer in dimming all variables
' Saves time/trouble in the long run
Dim pp As Presentation
Dim sh As Shape

Set pp = ActivePresentation

Set sh = pp.Slides(1).Shapes.AddShape(Type:=msoShapeRectangle, Left:=50, Top:=50, Width:=215, Height:=30)
With sh.ActionSettings(ppMouseClick)
.Action = ppActionHyperlink
End With

With sh.ActionSettings(ppMouseClick).Hyperlink
    .Address = "..\War Memorial Slides\War Memorial Slides - Badlesmere to Elmley.pptx"
    .SubAddress = "1. PowerPoint Presentation"
    .ScreenTip = "My Name"
End With

End Sub