[VBA进阶] 2、EXCEL批量插入图片(完美版)

2025-11-16 06:07:03

1、[第一步] 准备好需要插入图片的工作表,和图片源文件。如果工作表还没有打开“开发工具”选项卡的话,可以先百度一下怎么打开“开发工具”选项卡。

[VBA进阶] 2、EXCEL批量插入图片(完美版)

2、[第二步]  这一步需要将“批量插入图片”的代码放入到模块中。依次单击:开发工具选项卡→Visual Basic→插入→模块→复制以下代码到模块中→关闭VB代码编辑窗口

注意:代码复制过程中文字会自动换行,可以根据我提供的代码图片调整位置!!代码位置要和我图片中的一样,否则会出现运行不了的情况。

Public Sub Q()

'开始插入图片

    Application.ScreenUpdating = False

Dim PicName$, pand&, k&, PicPath, i, p, n, PicArr, TitleRow

Dim PicNameCol, PicPath2, PicPath3, TPnameCol, TPCol

    Set PicNameCol = Application.InputBox("请选择图片名称所在列,只能选择单列单元格!", Title:="图片名称所在列", Type:=8)

        '选择的图片名称所在列

    PicCol = PicNameCol.Column '取图片名称所在列列列标

    

    Set TPnameCol = Application.InputBox("请选择图片需要放置的列,只能选择单列单元格!", Title:="图片所在列", Type:=8)

        '选择的图片所在列

    TPCol = TPnameCol.Column '取图片所在列列列标

    

    TitleRow = Val(Application.InputBox("请输入标题行的行数。")) '用户设置总表的标题行数

    If TitleRow < 0 Then MsgBox "标题行必须大于等于零,请重新确认? ": Exit Sub

    

    With Application.FileDialog(msoFileDialogFolderPicker)

        .AllowMultiSelect = False '禁止多选文件夹

       If .Show Then PicPath = .SelectedItems(1) Else: Exit Sub

    End With

    If Right(PicPath, 1) <> "\" Then PicPath = PicPath & "\"

    PicArr = Array(".jpg", ".jpeg", ".bmp", ".png", ".gif") '假定图片格式有5种

    For i = TitleRow + 1 To Cells(Rows.Count, PicCol).End(3).Row

        PicPath2 = PicPath

        PicName = Cells(i, PicCol).Value

        If Len(PicName) <> 0 Then '如果PicName不为空

            PicPath3 = PicPath2 & PicName

            pand = 0

            For p = 0 To UBound(PicArr)

                If Len(Dir(PicPath3 & PicArr(p))) Then '如果picpath路径下存在PicName图片

                    ActiveSheet.Shapes.AddPicture PicPath3 & PicArr(p), True, True, _

                    Cells(i, TPCol).Left, Cells(i, TPCol).Top, _

                    Cells(i, TPCol).Width, Cells(i, TPCol).Height

                    pand = 1

                    n = n + 1

                End If

            Next

            If pand = 0 Then k = k + 1

            End If

    Next

    Application.ScreenUpdating = True

    If k <> 0 Then

        MsgBox "图片插入完成!共有" & k & "张图片未找到,请重新确认源文件! "

    Else

        MsgBox "所有图片插入完成!"

    End If

End Sub

[VBA进阶] 2、EXCEL批量插入图片(完美版)

[VBA进阶] 2、EXCEL批量插入图片(完美版)

3、[第三步]  在工作表中插入一个命令按钮,用来运行上面的程序。依次单击:开发工具→插入→表单控件→按钮(窗体控件)→通过鼠标在工作表中画一个按钮→在弹出的窗口中选择宏“Q”→确定

[VBA进阶] 2、EXCEL批量插入图片(完美版)

[VBA进阶] 2、EXCEL批量插入图片(完美版)

4、[第四步]  开始运行程序。单击刚刚创建的“按钮”→选择图片名称所在的列→选择图片需要插入的列→输入标题行的行数→打开原图片所在文件夹→完成。图片插入完成以后会提示你是否有图片未找到,这时需要对文件名和格式进行确认。

[VBA进阶] 2、EXCEL批量插入图片(完美版)

5、这组插入图片的代码不需要设置参数,它会根据单元格大小自适应!!!

如果觉得这篇经验帮到了你,请点击下方的 “投票" 和 "有得" 支持我!

还有疑问的话可以点击下方的 “我有疑问”,谢谢啦!

声明:本网站引用、摘录或转载内容仅供网站访问者交流或参考,不代表本站立场,如存在版权或非法内容,请联系站长删除,联系邮箱:site.kefu@qq.com。
猜你喜欢