PowerPoint VBA创建带超链接形状时无法添加文本问题求助

为什么.TextToDisplay会报错？ #

.TextToDisplay是文本超链接（比如选中文字添加的超链接）专属属性，而你通过ActionSettings设置的是形状的动作超链接，这个对象并不支持TextToDisplay，所以触发了报错。

正确解决方案 #

要实现「创建形状+添加文本+设置超链接」的需求，需拆分两步操作：先给形状添加文本，再绑定超链接，以下两种方案任选其一：

方案1：给整个形状绑定动作超链接（保留原有逻辑） #

先通过形状的TextFrame.TextRange.Text添加显示文本，再设置形状的点击跳转动作：

Sub CreateIndx()
    Set pp = ActivePresentation
    ' 创建矩形形状
    Set sh = pp.Slides(1).Shapes.AddShape(Type:=msoShapeRectangle, Left:=50, Top:=50, Width:=215, Height:=30)
    
    ' 给形状添加显示文本
    sh.TextFrame.TextRange.Text = "My Name"
    
    ' 设置形状的点击跳转超链接
    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
End Sub

方案2：给形状内的文本绑定超链接（仅点击文字跳转） #

如果需要仅让文本具备超链接（而非整个形状点击都跳转），可以用此方案：

Sub CreateIndxWithTextHyperlink()
    Set pp = ActivePresentation
    Set sh = pp.Slides(1).Shapes.AddShape(Type:=msoShapeRectangle, Left:=50, Top:=50, Width:=215, Height:=30)
    
    ' 添加文本并为文本绑定超链接
    With sh.TextFrame.TextRange
        .Text = "My Name"
        ' 给文本设置超链接
        Set hl = .ActionSettings(ppMouseClick).Hyperlink
        hl.Address = "..\War Memorial Slides\War Memorial Slides - Badlesmere to Elmley.pptx"
        hl.SubAddress = "1. Powerpoint Presentation"
    End With
End Sub

关键提示 #

• 大部分形状默认带TextFrame，但部分特殊形状（如线条、自由图形）需先确认支持文本编辑，可改用.TextFrame2.TextRange.Text尝试
• 动作超链接绑定在形状上，点击形状任意区域都会跳转；文本超链接仅绑定在文字上，只有点击文字才触发跳转

内容的提问来源于stack exchange，提问作者Stephen