Vba 通过Excel中的单元格向图像添加超链接

有没有办法将单元格中提供的超链接添加到图像中

我尝试了以下VBA代码：

Sub Storage_Test_Click()
    ActiveSheet.Hyperlinks.Add Anchor:=storage_image, Address:=Worksheets("Links").Range("B8:B8").Value
End Sub 

但是有了这段代码，链接是持久的。换句话说，如果我更改单元格值，图像中的链接不会受到影响

谢谢， 特罗

---

不要将宏指定给图像，因为您无法单击图像（因为它是一个超链接！），如果在更新链接后用原始代码右键单击图像，我确信会选择它，并且宏将运行，但是上述更改意味着每次您在工作表上进行选择时，您的链接将更新

在模块中输入类似内容

然后在链接表中：

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo halt
    Application.EnableEvents = False
    If Not Intersect(Target, [B8]) Is Nothing Then
        '~~> use the sub here, assuming Picture named "Picture 1" is in Sheet2
        Add_HLink Sheet2, "Picture 1" '~~> change the arguments to suit
    End If
continue:
    Application.EnableEvents = True

    Exit Sub
halt:
    MsgBox Err.Description
    Resume continue
End Sub

---

这就是你想要的吗？HTH.

根据您的代码，当您更改B8的值以更新链接时，必须单击该按钮。如果您希望它在更改B8时自动将链接附加到图像，则需要工作表\u更改事件。

Sub Add_HLink(ws As Worksheet, picture_name As String)
    Dim sh As Worksheet: Set sh = Worksheets("Link")
    Dim shp As Shape
    For Each shp In ws.Shapes
        If shp.Type = msoPicture And shp.Name = picture_name Then
            ws.Hyperlinks.Add shp, sh.Range("B8").Value
            Exit For
        End If
    Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo halt
    Application.EnableEvents = False
    If Not Intersect(Target, [B8]) Is Nothing Then
        '~~> use the sub here, assuming Picture named "Picture 1" is in Sheet2
        Add_HLink Sheet2, "Picture 1" '~~> change the arguments to suit
    End If
continue:
    Application.EnableEvents = True

    Exit Sub
halt:
    MsgBox Err.Description
    Resume continue
End Sub