问如何在用图片替换文本后保留单元格的超链接？

EN

Sub test()
    Dim MyPath As String
    Dim Cell As Range
    Dim shp As ShapeRange
    Dim ws As Worksheet
    Dim rng As Range
    Dim ext As String
    Dim HyperLinkAddr As String

    Application.ScreenUpdating = False

    Set ws = ActiveSheet

    MyPath = "C:\Users\" & Environ$("UserName") & "\Pictures"
    ext = ".png"

    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"

    With ws
        Set rng = .Range(.Cells(1, 2), .Cells(.Rows.Count, "B").End(xlUp))
    End With

    For Each Cell In rng
        If Cell.Value <> vbNullString Then
            If Dir(MyPath & Cell.Value2 & ext) <> "" Then
                ' Get a reference to the inserted shape, rather than relying on Selection
                Set shp = ws.Pictures.Insert(MyPath & Cell.Value2 & ext).ShapeRange
                With shp
                    .LockAspectRatio = msoFalse
                    .Left = Cell.Left
                    .Top = Cell.Top
                    .Width = Cell.Width
                    .Height = Cell.Height

                    If Cell.Hyperlinks.Count > 0 Then
                        HyperLinkAddr = Cell.Hyperlinks(1).Address
                        Cell.Hyperlinks.Delete
                        ws.Hyperlinks.Add _
                          Anchor:=.Item(1), _
                          Address:=HyperLinkAddr
                    End If
                End With
            Else
                Cell.Value = "N/A"
            End If
        End If
    Next

    Application.ScreenUpdating = True
End Sub