批量插入图片 10s完成其他人一个钟的事情
点击上方“Excel和VBA”，选择“置顶公众号” 致力于原创分享Excel的相关知识，源码，源文件打包提供 一起学习，一起进步~~
在我们日常的工作中，将会用到将图标插入Excel的操作 比方说做一个花名册，比方说做一个产品的库存表。。。。 这些操作都需要将图片插入到Excel中 常规的Excel插入图片，步骤很繁琐 
完成了图片的插入之后，你还需要按照单元格的内容进行调整，整个如果需要插入的图片数量很多，那么这个工作量非常的客观，20个图片，你花费一个钟都不是开玩笑的事情 那么这个时候，我们就需要使用VBA了。 VBA可以帮组我们快速的实现这个图片的插入，在插入的同时，还可以调整图片的大小。 绝对是福音啊 场景说明
今天我们借用之前的场景，我们需要有这么几个动漫人物的图片，我们现在需要将他们插入到对应的单元格当中 当然不是随机的任意插入，而是按照需要，根据对应的名称来插入 说到对应名称，拿到VBA还可以认识动漫人物？ 不不不，这个对应名称，就是图片的名称 
所以这也是要求我们在使用这个方法的时候，一定要给图片做好命名，不然VBA可能真的不知道怎么对应了。 代码区直接来看看代码，今天的代码就可能会比较长了。 Sub test()
Dim Arr, i&, k&, n&, pd&
Dim strPicName$, strPicPath$, strFdPath$, shp As Shape
Dim Rng As Range, Cll As Range, Rg As Range, strWhere As String
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then
strFdPath = .SelectedItems(1)
Else:
Exit Sub
End If
End With
If Right(strFdPath, 1) <> "\" Then
strFdPath = strFdPath & "\"
End If
Set Rng = Application.InputBox("请选择图片名称所在的单元格区域", Type:=8)
Set Rg = Rng.Offset(0, 1)
Application.ScreenUpdating = False
Rng.Parent.Select
For Each shp In ActiveSheet.Shapes
If Not Intersect(Rg, shp.TopLeftCell) Is Nothing Then
shp.Delete
End If
Next shp
x = Rg.Row - Rng.Row
y = Rg.Column - Rng.Column
Arr = Array(".jpg", ".jpeg", ".bmp", ".png", ".gif")
For Each Cll In Rng
strPicName = Cll.Text
If Len(strPicName) Then
strPicPath = strFdPath & strPicName
pd = 0
For i = 0 To UBound(Arr)
If Len(Dir(strPicPath & Arr(i))) Then
Set shp = ActiveSheet.Shapes.AddPicture( _
strPicPath & Arr(i), False, True, _
Cll.Offset(x, y).Left + 5, _
Cll.Offset(x, y).Top + 5, _
20, 20)
shp.Select
With Selection
.ShapeRange.LockAspectRatio = msoFalse
.Height = Cll.Offset(x, y).Height - 10
.Width = Cll.Offset(x, y).Width - 10
End With
pd = 1
n = n + 1 '
[a1].Select: Exit For
End If
Next
If pd = 0 Then k = k + 1
End If
Next
Application.ScreenUpdating = True
MsgBox "共处理成功" & n & "个图片，另有" & k & "个非空单元格未找到对应的图片。"
End Sub似乎还有不少非常少见的VBA代码，不要紧，我们只要知道大致的思路和方法就可以了 我们先来看看代码实现的效果怎么样 
效果还是比较的不错的。 代码解析今天的代码呢 看起来很常，也比较的复杂，有一些是我们之前没有接触过的 不过不要着急，我们只要理解代码的作用和意义，就可以灵活的套用的 With Application.FileDialog(msoFileDialogFolderPicker)
***
End with这个大家都很熟悉了，完全就是利用VBA的文件夹选项，选择对应的图片所在的文件夹 划重点 这里是选择文件夹，不是选择具体的图片哦。选到文件夹就可以了。 For Each shp In ActiveSheet.Shapes
If Not Intersect(Rg, shp.TopLeftCell) Is Nothing Then
shp.Delete
End If
Next shp这一段代码是非常有用的，什么用处呢？ 我们回到案例中 
这是我们刚刚的成品，假设我现在更改了动漫名称，我现在需要重新填充图片，我是不是要先删除原来的图片呢？ 如果不删除，那新的图片是不是就会覆盖到原来的图片上了呢 所以这个时候我们需要先删除原来的旧图片，如何删除，就用上面的代码 他就是将所有的图片删除的功能。 With Selection
.ShapeRange.LockAspectRatio = msoFalse
.Height = Cll.Offset(x, y).Height - 10
.Width = Cll.Offset(x, y).Width - 10
End With这段代码是灵活的 主要是用来调整图片的大小的，如果大家感觉图片的不合适的话，就只需要调整这一部分就可以了。 其他的代码，虽然比较难理解，但是是现成的轮子，我们直接套用就好了
|
