问取消链接图片超链接

EN

ActiveSheet.Shapes.Range(Array("Picture 1")).ShapeRange.Item(1).Hyperlink.Delete

err.clear
on error resume next 'everything not working will throw an Error
with activesheet.shapes("Picture 1") 
    .type=13 'forcfully changing the type form a linketype to normal picture, might not work
    .linkformat.autoupdate = false 'might not work
    .hyperlink = false 'might not work
    .formula = VbNullString 'might not work

    'if all fails try the last hope (copy it but no link)
    .copy 'if fails : ActiveSheet.Pictures.Paste link:=True
    'activesheet.Pictures.Paste link:=True 'failed (works only for picture copy of ranges ?)
    ActiveSheet.PasteSpecial Format:="Picture (Enhanced Metafile)"
    'you can save .top and .left in a single variable and replace the new pic on the right place
    Dim X as single, Y as Single
    X=.left
    Y=.top


    with activesheet.shapes(activesheet.shapes.count) 'the new pic is the last in shapes collection
    'same result but i like it less, with : selection.shaperange.item(1) ' you need to be in the picture's sheet, wich in our case is ok because we work on activesheet
         .top=Y
         .left=X
         .name = "Picture 1"
     End with
     .delete 'removes the old picture
End With