Add a Hyperlink to a SmartArt Node

问题

In the Excel (also PowerPoint and Word) user interface it's possible to assign a hyperlink to a SmartArt node, or text in a node:

Recording these steps in a macro yields an empty procedure.

Trying to use logic with the object model yields no useful result (see code below). I tried the following three approaches:

A SmartArtNode has a Shapes property and one can extract a Shape object... But the type belongs to the Office object model (Office.Shape) and cannot be coerced (that I can find) to an Excel.Shape (nor to a PowerPoint.Shape). Trying to assign it to an Excel.Shape - Set xlShape = nd1.Shapes(1) - results in

Run-time error '13' Type mismatch

Trying to add a hyperlink to the Office.Shape results in

Run-time error -2147417848 (80010108)

Automation error
The object invoked has disconnected from its clients.

Then I tried selecting the node and adding the hyperlink to Application.Selection (TypeName(Application.Selection) returns Shape) which returned

Run-time error 1004
Application-defined or object-defined error

How does one add a hyperlink to a SmartArt node?

Sub AddHyperlinkToSmartArtNode()
  Dim sa As SmartArt
  Dim ws As Worksheet
  Dim nd1 As SmartArtNode
  Dim shp As Office.Shape
  Dim shpx
  Dim rng As TextRange2

  Set ws = ActiveSheet
  Set sa = ws.Shapes(1).SmartArt
  Set nd1 = sa.Nodes(1)

  'Dim xlShape As Excel.Shape
  'Set xlShape = nd1.Shapes(1)
  'Run-time error '13'
  'Type mismatch

  Set shp = nd1.Shapes(1)

  'ws.Hyperlinks.Add shp, "www.google.com"
  'Run-time error -2147417848 (80010108)
  'Automation error
  'The object invoked has disconnected from its clients.

  Set rng = shp.TextFrame2.TextRange
  rng.Select
  Set shpx = Application.Selection
  ws.Hyperlinks.Add shpx, "www.google.com"
  'Run-time error 1004
  'Application-defined or object-defined error
End Sub

来源：https://stackoverflow.com/questions/58527055/add-a-hyperlink-to-a-smartart-node

标签

excel

vba

powerpoint