office交流網(wǎng)--QQ交流群號及微信交流群

Access培訓(xùn)群:792054000         Excel免費交流群群:686050929          Outlook交流群:221378704    

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

微信交流群(請用微信掃碼)

        

Excel VBA實現(xiàn)圖片文本網(wǎng)絡(luò)地址轉(zhuǎn)變?yōu)閳D片

2019-11-07 16:26:00
tmtony8
原創(chuàng)
7080

在Excel數(shù)據(jù)表格中有些網(wǎng)頁圖片的鏈接。希望把這些鏈接轉(zhuǎn)變成對應(yīng)的圖片


通過下面代碼,可以先把圖片文本地址轉(zhuǎn)變成超鏈接格式

然后插入圖片到鏈接對應(yīng)的單元格內(nèi),可以先設(shè)置單元格的長寬,這樣圖片會按單元格大小自動生成

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 '循環(huán)活動工作表中的各個超鏈接 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圖片(此處僅針對此兩種圖片類型,更多類型可以通過建立數(shù)組或字典或正則來判斷) Set Rng = HLK.Parent.Offset(, 0) '設(shè)定插入目標圖片的位置 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



如圖所示,文本鏈接成功轉(zhuǎn)換成圖片

    分享
    文章分類
    聯(lián)系我們
    聯(lián)系人: 王先生
    Email: 18449932@qq.com
    QQ: 18449932
    微博: officecn01
    移動訪問