[转载]将Excel中的图片URL地址转成图片文件

原博https://blog.csdn.net/lsg9012/article/details/77162976

前阵子从数据库中导出数据给业务,但是图片是个URL,业务需要在 Excel 中直接显示图片,因此在网上爬了很多VB脚本尝试修改,最终将Excel中的图片URL转换成了图片。

VB脚本 LoadImage.bas :


Sub LoadImage()  
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  




评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值