Private Sub Workbook_Open()
Dim se As Worksheet
Dim boo As Boolean
For Each se In Worksheets
Dim HLK As Hyperlink, Rng As Range
For Each HLK In se.Hyperlinks '循环活动工作表中的各个超链接
On Error GoTo ErrorHandler
If UCase(HLK.Address) Like "*.JPG" Or UCase(HLK.Address) Like "*.JPEG" Or UCase(HLK.Address) Like "*.PNG" Or UCase(HLK.Address) Like "*.GIF" Then '如果链接的位置是jpg或gif图片(此处仅针对此两种图片类型,更多类型可以通过建立数组或字典或正则来判断)
boo = True
Set Rng = HLK.Range '设定插入目标图片的位置
With se.Pictures.Insert(HLK.Address) '插入链接地址中的图片
.Top = Rng.Top
.Left = Rng.Left
.Width = Rng.Width
.Height = Rng.Height
End With
If boo Then
HLK.Address = ""
HLK.Range.Value = "" '删除单元格的图片链接
End If
End If
ErrorHandler:
boo = False
Resume Next
Next
Dim picSize As Shape
For Each picSize In se.Shapes
Set picArea = picSize.TopLeftCell.MergeArea
picSize.LockAspectRatio = False
picSize.Top = picSize.Top + 5
picSize.Left = picSize.Left + 5
picSize.Height = picArea.Height - 10
picSize.Width = picArea.Width - 10
Next
Next
End Sub