VBA之批量导入图片

在做外贸的过程中，我们经常要有给客户报价的动作，而我们的报价表通常会插入图片
当一份报价只有两三张图片的时候，我们不会觉得难，当一份报价有超过20张图片时，马上觉得是一份辛苦的差事
如下图：

产品图片

自从学了VBA之后，我发现今后再做此类型的报价图片，只要一键就可以搞定。
在点击之前先调整一下我们需要展示图片的行高及列宽，如下图操作

批量导入图片3.gif

VBA代码如下：

Sub 给文件夹下的图片建文档()
Dim sr$, n%
Dim rng As Range, ph$, sp As Shape
sr = Dir(ThisWorkbook.Path & "\素材图片\")
Columns("a:a").ClearContents
[a1] = "名称": [b1] = "图片"
n = 1
Do
n = n + 1
Cells(n, 1) = sr
sr = Dir
Loop Until sr = ""
For Each sp In ActiveSheet.Shapes
If sp.Type = 11 Then
    sp.Select
    sp.Delete
End If
Next
ph = ThisWorkbook.Path & "\素材图片\"
For Each rng In Range("a2", [a2].End(xlDown))
ActiveSheet.Shapes.AddPicture ph & rng, 1, 1, rng(1, 2).Left, rng(1, 2).Top, rng(1, 2).Width, rng(1, 2).Height
Next
End Sub

使用此文件要做动作
1、将要建图片EXCEL文件的图放入到"素材图片"文件夹中
2、EXCEL文件放在素材图片文件之外
3、打开EXCEL文件，按上视频操作做就可以了，打开之后要允许宏启用。

附百度文档
链接：https://pan.baidu.com/s/1Ww9MRyTmangyP7hNNXRmsw
提取码：nkye