Sub LoadImage()
Dim HLK As Hyperlink, Rng As Range
Dim i As Integer
For i = 1 To Sheets.Count
For Each HLK In Sheets(i).Hyperlinks '回圈活動作業表中的各個超鏈接
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圖片(此處僅針對此兩種圖片型別,更多型別可以通過建立陣列或字典或正則來判斷)
Set Rng = HLK.Range.Offset(0, 0) '設定插入目標圖片的位置
With Sheets(i).Pictures.Insert(HLK.Address) '插入鏈接地址中的圖片
On Error Resume Next
If .Height / .Width > Rng.Height / Rng.Width Then '判斷圖片縱橫比與單元格縱橫比的比值以確定針對單元格縮放的比例
.Top = Rng.Top
.Left = Rng.Left + (Rng.Width - .Width * Rng.Height / .Height) / 2
.Width = .Width * Rng.Height / .Height
.Height = Rng.Height
.Placement = xlMoveAndSize
//我想給圖片加上超鏈接，這一段要怎么寫
.Pictures.Insert(HLK.Range.Value).Select
.Hyperlinks.Add Anchor:=Selection.ShapeRange, Address:=HLK.Range.Value
//我想給圖片加上超鏈接
Else
.Left = Rng.Left
.Top = Rng.Top + (Rng.Height - .Height * Rng.Width / .Width) / 2
.Height = .Height * Rng.Width / .Width
.Width = Rng.Width
.Placement = xlMoveAndSize
//我想給圖片加上超鏈接，這一段要怎么寫
.Pictures.Insert(HLK.Range.Value).Select
.Hyperlinks.Add Anchor:=Selection.ShapeRange, Address:=HLK.Range.Value
//我想給圖片加上超鏈接
End If
End With
HLK.Range.Value = "" '洗掉單元格的圖片鏈接
End If
Next
Next i
End Sub
uj5u.com熱心網友回復：
我想在插入圖片后，給圖片增加超鏈接。但是這段要怎么寫
轉載請註明出處，本文鏈接：https://www.uj5u.com/caozuo/268424.html