Excel根据链接批量下载图片

Excel中有很多图片的链接，需要将其下载并插入到相邻单元格中。一般的操作步骤如下：

复制链接到浏览器地址栏，右键点击图片另存到本地，在Excel插入图片到对应单元格中，并用鼠标拖拽调整大小。

那有没有快速且轻松的方法呢？可以用VBA代码来实现。

1、录入VBA代码

右键单击工作表名称，选择[查看代码]，进入VBA编码界面。

输入以下代码：

Sub UrlPicDownload()
'根据A列图片链接下载图片
Dim shp As Shape, pic As Shape
Dim rng As Range, NewRng As Range
Dim col As Long, RowNum As Long
Dim PicAspectRatio As Single
On Error Resume Next
Application.ScreenUpdating = False
'关闭提示信息
'删除当前Sheet中的所有图片
For Each pic In ActiveSheet.Shapes
If pic.Type = 11 Or pic.Type = 13 Then
pic.Delete
End If
Next
RowNum = WorksheetFunction.CountA(ActiveSheet.Range("A:A"))
'获取A列非空行数
If RowNum < 2 Then GoTo Lab '如只有标题行则跳转 Set rng = ActiveSheet.Range("A2:A" & RowNum) For Each cell In rng Filename = cell ActiveSheet.Pictures.Insert(Filename).Select Set shp = Selection.ShapeRange.Item(1) PicAspectRatio = shp.Width / shp.Height '获取图片长宽比 If shp Is Nothing Then GoTo Lab col = cell.Column 1 Set NewRng = Cells(cell.Row, col) With shp .LockAspectRatio = msoFalse If .Height > NewRng.Height Then .Height = NewRng.Height * 3 / 4
'设置图片高度
.Width = .Height * PicAspectRatio
'设置图片宽度 按图片原比例
.Top = NewRng.Top   (NewRng.Height - .Height) / 2
.Left = NewRng.Left   (NewRng.Width - .Width) / 2
End With
Lab:
Set shp = Nothing
Range("A2").Select
Next
Application.ScreenUpdating = True
'开启提示信息
End Sub

说明：

该代码也有不灵活的地方，便于演示，从以下几方面进行了限制，需要根据实际情况进行调整。

① 对存放图片链接的单元格进行了限制。

② 对图片的大小进行了设置，居中存放于单元格中。

③ 对存放图片的单元格进行了限定。

2、为VBA代码指定按钮

选择菜单栏[开发工具]=>[插入]=>[按钮]

然后在单元格单击，这时会弹出[指定宏]界面，选择代码UrlPicDownload，则将VBA代码指定到了新添加的按钮中。

再右键单击按钮，选择[编辑文字]，修改按钮名称，比如将按钮命名为“下载图片”。