Excel将单元格内的url批量转化为图片格式的三种方法

2020-06-09 11:04:39 浏览数 (1)

一、打开开发工具选项卡调用VB编程功能

文件——选项

勾选开发工具

i将excel另存为能启用宏的xlsm格式

二、将url转化为图片的三种方法

1、同时保留图片和连接(编写vb程序并调用对应的宏)

首先先把所有链接转化为超链接形式(蓝色字体带下划线)

有个别链接为黑体格式

开发工具——Visual Basic(或者ALT F11快捷键)进入VB界面,然后双击sheet1按钮打开VB编程窗口

VB编程窗口

输入以下代码并保存

代码语言:javascript复制
Sub loadimage()
Dim HLK As Hyperlink, Rng As Range
For Each HLK In ActiveSheet.Hyperlinks  '循环活动工作表中的各个超链接
    If HLK.Address Like "*.jpg" Or HLK.Address Like "*.gif" Then  '如果链接的位置是jpg或gif图片(此处仅针对此两种图片类型,更多类型可以通过建立数组或字典或正则来判断)
        Set Rng = HLK.Parent.Offset(, 1)  '设定插入目标图片的位置
        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
    End If
Next
End Sub

输入vb代码

开发工具-宏-执行

执行宏后显示图片

2、删除链接只保留图片(插入VB脚本方式)

新建记事本保存以下代码另存为.bas格式

代码语言:javascript复制
'charset GB2312 . Excel 中的图片链接转为图片文件

Attribute VB_Name = "LoadImage"
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

在VB界面右键sheet页选择导入文件

右键sheet选择导入文件

导入文件后出现模块

开发工具-宏-执行LoadImage模块

执行LoadImage宏

执行后的结果

3、主动选择是否打开图片

同方法1,但是需要选择声明为BeforeRightClick,设置为右键时触发

右键点击触发宏

在对应的时间方法中插入如下代码

代码语言:javascript复制
With Target
        If Left(.Value, 7) = "http://" Then '如果单元格内容为网址
            '添加网络图片,并设置为图片大小位置随单元格变化而变化
            ActiveSheet.Shapes.AddPicture(.Value, msoCTrue, msoCTrue, .Left, .Top, .Width, .Height).Placement = xlMoveAndSize
            .WrapText = True '单元格设置为自动换行,以隐藏网址
        End If
End With

右键单元格就可以显示图片

补充

解决评论区的将非超链接的网址显示成图片的问题

代码语言:javascript复制
Sub loadimage()
Dim ranTotal As Range, rng As Range, imageRng As Range '设定三个Range变量
Set rngTotal = Range("o:o")  '选中存放网址的o列
For Each rng In rngTotal     '遍历所有的o列单元格
    If Left(rng.Value, 7) = "http://" Then '如果单元格内容为网址
        Set imageRng = rng.Offset(, 1)  '存放图片的地址
        With ActiveSheet.Pictures.Insert(rng.Value)
            If .Height / .Width > imageRng.Height / imageRng.Width Then  '判断图片纵横比与单元格纵横比的比值以确定针对单元格缩放的比例
                .Top = imageRng.Top
                .Left = imageRng.Left   (imageRng.Width - .Width * imageRng.Height / .Height) / 2
                .Width = .Width * imageRng.Height / .Height
                .Height = imageRng.Height
            Else
                .Left = imageRng.Left
                .Top = imageRng.Top   (imageRng.Height - .Height * imageRng.Width / .Width) / 2
                .Height = .Height * imageRng.Width / .Width
                .Width = imageRng.Width
            End If
        End With
    End If
Next
End Sub

0 人点赞