如何通过VBA为指定名称的Excel形状添加指向Sheet2对应行的超链接？

核心代码实现 #

直接通过单元格值获取形状名称和目标行号，无需选中操作，代码更稳定：

Sub AddShapeHyperlink()
    Dim shapeName As String
    Dim targetRow As Long
    Dim targetShape As Shape
    
    ' 从C2读取要操作的形状名称
    shapeName = ActiveSheet.Range("C2").Value
    ' 从C4读取Sheet2的目标行号
    targetRow = ActiveSheet.Range("C4").Value
    
    ' 检查形状是否存在，避免报错
    On Error Resume Next
    Set targetShape = ActiveSheet.Shapes(shapeName)
    On Error GoTo 0
    
    If Not targetShape Is Nothing Then
        ' 给形状添加超链接，指向Sheet2对应行的A列
        ActiveSheet.Hyperlinks.Add _
            Anchor:=targetShape, _
            Address:="", _
            SubAddress:="Sheet2!A" & targetRow, _
            TextToDisplay:=shapeName ' 可选：设置超链接显示文本
    Else
        MsgBox "未找到名称为 """ & shapeName & """ 的形状！"
    End If
End Sub

代码说明 #

1. 避免Select操作：直接通过Shapes(shapeName)引用形状，不会因工作表选中状态变化导致错误
2. 内部链接格式：工作簿内的超链接用SubAddress参数指定，格式为工作表名!单元格地址，Address留空即可
3. 错误处理：加入形状存在性检查，防止因形状名称错误导致代码崩溃

批量处理多个形状 #

如果需要为多个形状批量添加超链接（比如每组数据按C2/C4、C6/C8的间隔排列），可以用循环实现：

Sub BatchAddShapeHyperlinks()
    Dim i As Integer
    Dim shapeName As String
    Dim targetRow As Long
    Dim targetShape As Shape
    
    ' 循环处理所有组数据，步长4对应C2/C4、C6/C8的间隔
    For i = 2 To ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row Step 4
        shapeName = ActiveSheet.Range("C" & i).Value
        targetRow = ActiveSheet.Range("C" & i + 2).Value
        
        On Error Resume Next
        Set targetShape = ActiveSheet.Shapes(shapeName)
        On Error GoTo 0
        
        If Not targetShape Is Nothing Then
            ActiveSheet.Hyperlinks.Add _
                Anchor:=targetShape, _
                Address:="", _
                SubAddress:="Sheet2!A" & targetRow, _
                TextToDisplay:=shapeName
        End If
    Next i
End Sub

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