单击超链接时,有没有办法刷新/更新形状中的超链接?

时间:2013-04-26 23:13:01

标签: vba excel-vba hyperlink shapes excel

我在图表中有表示数据流中的进程的形状;根据形状和形状名称中的文本将形状超链接到位于另一个选项卡中的流程定义(例如,形状命名为"控制##"带文本" ABC"链接到选项卡其中定义了ABC过程)。如果我将形状中的文本更改为" XYZ"有没有办法自动更新该形状中的超链接。 - 即我想要超链接然后转到" XYZ"定义?我尝试了SheetFollowHyperlink事件过程,但似乎没有任何事情发生。我到目前为止的代码如下:

Sub AssignHyperlink()

Dim CallerShapeName As String
CallerShapeName = Application.Caller

With ActiveSheet
    Dim CallerShape As Shape
    Set CallerShape = .Shapes(CallerShapeName)

    Dim RowVar As Integer

    Err.Number = 0
    On Error Resume Next

    If InStr(CallerShapeName, "Control") = 1 Then

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

        If (Err.Number = 1004) Then
            MsgBox "No match found for this shape text in the Control Point Log"
            Exit Sub
        End If

        On Error GoTo 0

        .Hyperlinks.Add Anchor:=CallerShape, _
        Address:=ActiveWorkbook.Name & "#" & "'Control Point Log'!$C$" & RowVar

    Else

        RowVar = Application.WorksheetFunction _
            .Match(.Range("C2").Value & CallerShape.TextFrame2.TextRange.Text, _
            Sheets("Data Flow Glossary").Range("A1:A700"), 0)

        If (Err.Number = 1004) Then
            MsgBox "No match found for this shape text in the Data Flow Glossary"
            Exit Sub
        End If

        On Error GoTo 0

        .Hyperlinks.Add Anchor:=CallerShape, _
        Address:=ActiveWorkbook.Name & "#" & "'Data Flow Glossary'!$C$" & RowVar

    End If

End With

End Sub

1 个答案:

答案 0 :(得分:1)

1st。我认为您的目标是在点击形状后导航到工作簿中的范围

2nd。导航到的范围名为range。

第3个。导航范围等于形状中的文字。

我的建议是使用onAction形状触发器(右键单击形状时assign macro

4rd。我们需要以下程序 - 一个适用于所有形状。

Sub Hyperlink_Workaround()
    On Error GoTo ErrorHandler

    Dim curHL As String
        curHL = ActiveSheet.Shapes(Application.Caller).TextFrame2.TextRange.Text

    'which way do you define destination?
    'this way you go to named range

    Application.Goto Range(curHL), True
    Exit Sub
ErrorHandler:
    MsgBox "There is no range like " & curHL
End Sub

5th。测试,在上面分配了宏的工作表上具有以下形状,点击任何形状后,我们将移动到工作簿中的ABC或DEF范围。 enter image description here

6th。当您尝试导航到不存在的范围时,我为情境添加了处理程序。