excel宏自动将图片url转为图片

复制代码
Private Sub Workbook_Open()
    Dim se As Worksheet
    Dim boo As Boolean
    For Each se In Worksheets
        Dim HLK As Hyperlink, Rng As Range
        For Each HLK In se.Hyperlinks  '循环活动工作表中的各个超链接
            On Error GoTo ErrorHandler
            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图片(此处仅针对此两种图片类型,更多类型可以通过建立数组或字典或正则来判断)
                boo = True
                Set Rng = HLK.Range  '设定插入目标图片的位置
                With se.Pictures.Insert(HLK.Address)  '插入链接地址中的图片
                    .Top = Rng.Top
                    .Left = Rng.Left
                    .Width = Rng.Width
                    .Height = Rng.Height
                End With
                If boo Then
                    HLK.Address = ""
                    HLK.Range.Value = ""   '删除单元格的图片链接
                End If
            End If
ErrorHandler:
    boo = False
    Resume Next
        Next
        Dim picSize As Shape
        For Each picSize In se.Shapes
            Set picArea = picSize.TopLeftCell.MergeArea
            picSize.LockAspectRatio = False
            picSize.Top = picSize.Top + 5
            picSize.Left = picSize.Left + 5
            picSize.Height = picArea.Height - 10
            picSize.Width = picArea.Width - 10
        Next
    Next
End Sub
复制代码

 

 

posted @   zhouxg72  阅读(593)  评论(0编辑  收藏  举报
(评论功能已被禁用)
相关博文:
阅读排行:
· 地球OL攻略 —— 某应届生求职总结
· 周边上新:园子的第一款马克杯温暖上架
· Open-Sora 2.0 重磅开源!
· .NET周刊【3月第1期 2025-03-02】
· [AI/GPT/综述] AI Agent的设计模式综述
点击右上角即可分享
微信分享提示