office交流网--QQ交流群号

Access培训群:792054000         Excel免费交流群群:686050929          Outlook交流群:221378704    

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

Excel VBA实现图片文本网络地址转变为图片

2019-11-07 16:26:00
tmtony8
原创
6351

在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



如图所示,文本链接成功转换成图片

    分享