每日Excel分享（VBA）| 批量导入任意文件夹的图片到Excel，就是这么简单！

为什么要提这篇文章呢？

因为村长今天要跟大家分享的内容其实和那篇文章也有很大关联，那就是如何根据图片的名称从文件夹中批量导入图片，效果如下图所示

打开VBE编辑器新建模块并添加VBA代码，如下图：

操作方法：

按ALT F11组合键打开VBE编辑器，选中任意一个工作表名点击右键，然后选择“插入——模块”，在模块中粘贴以下代码：

Option Explicit

Sub 批量导入相片()

    Dim i, myPath$, a, b, c, d, n%

    Dim p As Picture, k As FileDialog

    n = Sheets('Sheet1').Range('A65536').End(3).Row '获取数据区域单元格个数

    Set k = Application.FileDialog(msoFileDialogFolderPicker)

    If k.Show = -1 Then myPath = k.SelectedItems(1) & '\'

    Application.ScreenUpdating = False '关闭屏幕刷新

    For Each p In ActiveSheet.Pictures

        p.Delete

    Next

     On Error GoTo Y

    For i = 2 To n

        a = 0: b = 0: c = 0: d = 0 '赋值

        Range('B' & i).Select

        a = ActiveCell.Left '单元格左侧

        b = ActiveCell.Top '单元格顶部

        c = ActiveCell.Width '单元格宽度

        d = ActiveCell.Height '单元格高度

        ActiveSheet.Pictures.Insert(myPath & Range('A' & i).Value & '.jpg').Select '插入相应图片

        Selection.ShapeRange.LockAspectRatio = False '被选项的ShapeRange的LockAspectRatio=False

        Selection.ShapeRange.Left = a 1 '被选择的图片左侧 1

        Selection.ShapeRange.Top = b 1 '被选择的图片顶部 1

        Selection.ShapeRange.Width = c - 2 '被选择的图片宽度-2

        Selection.ShapeRange.Height = d - 2 '被选择的图片高度-2

Y:

    Next i

    Application.ScreenUpdating = True '开启屏幕刷新

    MsgBox '恭喜你!图片导入完成!'

End Sub

PS：上面代码中红色字体为代码，黑色字体为代码注解（可要可不要）

调整要导入图片的区域的行高和列宽

行高调整为120（160像素），列宽调整为20（165像素），也就是我们常说的图片像素

165*160

执行代码批量导入图片到Excel

操作步骤：

1、点击“开发工具”选项卡，然后点击“宏”；

2、选中要执行的宏，然后点击“执行”；

3、在弹出的文件选择框中找到存放图片的文件夹点击确定导入即可。

PS：“开发工具”选项卡默认是不显示出来的，如果需要显示在选项卡中可以做如下设置：

1、Excel2010在“左上角文件——选项——自定义功能区”中勾选“开发工具”即可；

2、Excel2007在“左上角图标——选项——常用”中勾选“开发工具”即可；