office交流網--QQ交流群號

Access培訓群:792054000         Excel免費交流群群:686050929          Outlook交流群:221378704    

Word交流群:218156588             PPT交流群:324131555

Excel VBA實現圖片文本網絡地址轉變爲圖片

2019-11-07 16:26:00
tmtony8
原創
6768

在Excel數據錶格中有些網頁圖片的鏈接。希望把這些鏈接轉變成對應的圖片


通過下麵代碼,可以先把圖片文本地址轉變成超鏈接格式

然後插入圖片到鏈接對應的單元格內,可以先設置單元格的長寬,這樣圖片會按單元格大小自動生成

Sub HyperlinksToPic()
    On Error Resume Next
    
    i = 1
    
    Do While i <= Cells(Rows.Count, 1).End(xlUp).Row Cells(i, 1).Select link = Cells(i, 1).Value ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), Address:=link '把文本地址都變成超鏈接 i = i + 1 Loop Dim HLK As Hyperlink, Rng As Range For Each HLK In ActiveSheet.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.Parent.Offset(, 0) '設定插入目標圖片的位置 With ActiveSheet.Pictures.Insert(HLK.Address) '插入鏈接地址中的圖片 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
                Else
                    .Left = Rng.Left
                    .Top = Rng.Top + (Rng.Height - .Height * Rng.Width / .Width) / 2
                    .Height = .Height * Rng.Width / .Width
                    .Width = Rng.Width
                End If
            End With
            HLK.Parent.Value = "" '刪除單元格的圖片鏈接
        End If
    Next
    
End Sub



如圖所示,文本鏈接成功轉換成圖片

    分享