有没有一种方法可以在VBA中调用非标准形状；使用application.caller不起作用

我想为工作簿中的形状指定一个宏，该宏将相对超链接指定给调用它的形状。我尝试使用application.caller获取形状的名称以分配超链接，但它不适用于所有形状，如流程图形状。关于如何让它适用于所有形状，有什么建议吗？我的工作表中的所有流程图形状都出现运行时错误，找不到指定名称的项。此代码适用于矩形等标准形状；但我的文档中需要流程图形状

'Hyperlink to tab "control point log" using text in shape and cell values

Sub Controlpointhyperlink()
Dim rowvar as integer

ActiveSheet.Shapes(Application.Caller).Select
Selection.ShapeRange.Item(1).Name = "thisshape"

rowvar = Application.WorksheetFunction _
     .Match(ActiveSheet.Range("C2").Value & _
     ActiveSheet.Shapes("thisshape").TextFrame2.TextRange.Text, _
     Sheets("Control Point Log").Range("A1:A700"), 0)

With ActiveSheet
     .Hyperlinks.Add Anchor:= .Shapes("thisshape"), _
     Address:=ActiveWorkbook.Name & "#" & "'Control Point Log'!$C$" & rowvar
End With

End Sub

---

问题是在您的代码中，您将每个形状的名称更改为“thisshape”，然后向其添加超链接。我已尝试更改代码，以便在宏的开头设置形状引用。然后宏将使用此引用。在MATCH函数调用之前添加了错误检查，因此如果函数没有找到任何内容，则会显示mesage框。我用不同的形状测试了它，包括流程图形状。希望这有帮助

Sub Controlpointhyperlink()

    Dim callerShapeName As String
    callerShapeName = Application.Caller

    With ActiveSheet
        Dim callerShape As Shape
        Set callerShape = .Shapes(callerShapeName)

        Dim findWhat As String
        findWhat = .Range("C2").Value & callerShape.TextFrame2.TextRange.Text

        Dim findWhere As Range
        Set findWhere = Sheets("Control Point Log").Range("A1:A700")

        Dim rowvar As Double

        Err.Number = 0
        On Error Resume Next

        rowvar = Application.WorksheetFunction.Match(findWhat, findWhere, 0)
        If (Err.Number = 1004) Then
            MsgBox "No match found for '" & findWhat & "' in range '" & findWhere.Address & "'."
            Exit Sub
        End If

        On Error GoTo 0

        Dim addressText As String
        addressText = ActiveWorkbook.Name & "#" & "'Control Point Log'!$C$" & rowvar
        .Hyperlinks.Add Anchor:=callerShape, Address:=addressText
    End With

End Sub

---

这里是您的错误，在这一行：

rowvar=Application…

。如果是，请在尝试检索文本之前，尝试添加到控制每个形状是否具有TextRange。谢谢，这适用于更多形状，但不适用于看起来像两个重叠矩形的形状。。。该形状仍然在callerShape=.Shapes（callerShapeName）行上给我一个运行时错误，找不到指定名称的项。这种形状的名称是流程图：预定义流程。这很奇怪，因为宏确实适用于流程图：磁盘。其他建议？谢谢你的帮助。这是来电者造成的。如果是字符串类型的调用方，则其长度限制为30个字符。30以上的字符将被截断。因此（如果可能）重命名名称超过30个字符的形状，使新名称短于或等于30个字符，调用者将返回此类形状的完整名称。此行为不取决于形状类型。如果重命名普通矩形，使其名称长度超过30，则调用者将只返回前30个字符，而形状（“剪切的形状名称”）将抛出错误，因为形状集合中不存在具有此名称的形状。