[VBA进阶] 1、根据图片名称批量插入图片

2025-11-02 22:22:14

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

[VBA进阶] 1、根据图片名称批量插入图片

[VBA进阶] 1、根据图片名称批量插入图片

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

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

Sub 图片插入()

Dim PicName, TitleRow As Long, PicCol As Long, MaxRow As Integer, i As Long

Dim a As String, b As String, c As String, d As String, PicPath As String, PicFormula As String

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

        '选择的图片名称所在列

    PicCol = PicName.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 & "\"

    a = "<table><img src=""" & PicPath

    b = ".jpg""width=""75""height=""100"">"

    MaxRow = Cells(Rows.Count, PicCol).End(3).Row '图片名称所在列的总行数

    PicFormula = ThisWorkbook.Path & "\" & Hour(Now) & Minute(Now) & Second(Now) & "图片公式" & ".txt"

    Open PicFormula For Output As 1  '生成txt文件,储存图片公式

    For i = TitleRow + 1 To MaxRow Step 1

        c = Cells(i, PicCol).Value

        d = a & c & b

        Print #1, d

        Next i

    Close 1

    Shell "Notepad.exe " & PicFormula, vbNormalFocus '打开txt文件

End Sub

[VBA进阶] 1、根据图片名称批量插入图片

[VBA进阶] 1、根据图片名称批量插入图片

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

[VBA进阶] 1、根据图片名称批量插入图片

[VBA进阶] 1、根据图片名称批量插入图片

4、[第四步]  这是作重要的一步了,开始运行程序。单击刚刚创建的“按钮”→选择图片名称所在的列→输入标题行的行数→打开原图片所在文件夹→得出一个TXT文本文件→将文本内容复制到要插入图片的位置→完成

[VBA进阶] 1、根据图片名称批量插入图片

5、[第五步]  最后是对参数的修改。可以从两个部分修改,第一是在代码中修改,在这里修改会对所有图片失效;第二,是在得出的TXT文本文件中修改,可以针对不同的图片修改,文件类型(如,jpg,png,gif,jpeg等),图片宽度,图片高度。

[VBA进阶] 1、根据图片名称批量插入图片

[VBA进阶] 1、根据图片名称批量插入图片

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