[Skill]VBA零基础入门及实例：批量将链接转成图片

简介

VBA（Visual Basic for Applications）是依附在应用程序（例如Excel）中的VB语言。只要你安装了Office Excel就自动默认安装了VBA，同样Word和PowerPoint也能调用VBA对软件进行二次开发而让一些特别复杂的操作“脚本化”。

如何打开VBA

1. 打开”开发工具“功能（首次使用VBA）

如果你是第一次使用VBA，需要打开“开发工具”功能。

2. 打开VBA的三种方式

2.1 开发工具——VisualBasic

2.2 ALT+F11快捷键

2.3 右键sheet页查看代码

3. VBA界面

一个简单的VBA程序

大部分程序入门都会写一个代码输出“Hello World”，我们写第一个程序在选定的单元格输出自己的昵称。

Sub 插入文字() 'sub定义一个过程
    Selection.Value = "TOMOCAT" '代码块
End Sub '结束一个过程

1. 新建模块

模块方便我们导出代码用于其他的Excel，所以养成良好的编程习惯插入模块。

２. 在指定区域写代码

3.执行代码

下面三种方法实现的功能相同，无须太纠结，选择最方便的即可。

• F5执行
• 运行选项卡

• 运行按钮

一点小建议——使用“立即窗口”

如果你用过Rstudio写R代码或者Spyder写Python代码的话，“立即窗口”类似于控制台，能提示代码编译错误和进行实时计算。

1. 打开“立即窗口

视图——立即窗口

2. 在立即窗口输入代码直接作用于excel

选中一个单元格，然后在立即窗口输入代码（不必定义Sub过程），敲击回车键执行：

可以看到执行后被选中的单元格出现了你的昵称，到此为止你已经完成了第一个VBA程序。

实例：将URL转化成图片

1. 背景描述

现在excel中有多个图片链接，我们希望将这些链接都转成图片。

2. 方法一：同时保留链接和图片

开发工具——Visual Basic（或者ALT+F11快捷键）进入VB界面，然后双击sheet1按钮打开VB编程窗口：

输入如下代码并保存：

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" Or HLK.Address Like "*.png" 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

开发工具-宏-执行：

执行结果：

2. 删除链接只保留图片（插入VB脚本方式）

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

'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页选择导入文件：

执行效果：

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

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

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

执行宏后右击单元格就可以展示图片。

4. 补充

如果你的Excel未能正确将网址识别成超链接，可以使用如下代码：

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