通过excel vba 批量插入图片

1、原表是这样的，根据A列款号，把相对应的图片填充到k列

2、excel中打开visual basic 编辑器，插入-插入模块

3、Sub a竖排插入图片()

Dim cellcolumn As String

Dim piccolumn As String

Dim shp As Shape

Dim pictype(1 To 3) As String

Dim picads As String

Dim i, j, k As Long

On Error Resume Next '容错处理

Application.ScreenUpdating = False '关闭屏幕更新，提升速度

pictype(1) = ".jpg"

pictype(2) = ".jpeg"

pictype(3) = ".png"

picads = "Z:\电商商品下单表\图片\图片汇总jpg\"

 cellcolumn = InputBox("输入款号所在列名称", "款号列名称", "A") '设置款号所在列

 piccolumn = InputBox("插入图片所在列名称", "图片列名称", "B") '设置插入图片所在第几列

  If piccolumn = "" Or cellcolumn = "" Then Exit Sub

  Columns(piccolumn).ClearComments '删除所有批注

  For Each shp In ActiveSheet.Shapes '删掉所有图片

   If shp.Type = msoShapeRectangle Then shp.Delete

  Next shp

    Columns(piccolumn).ColumnWidth = 8.5 '设置列宽8.5

    Rows("2:" & Cells(Rows.Count, cellcolumn).End(xlUp).Row).RowHeight = 50   '设置图片区域行高50

    For i = 2 To Cells(Rows.Count, cellcolumn).End(xlUp).Row '数字2是设置开始填充图片的行号是第2行

           For j = 1 To UBound(pictype)

                     If Dir(picads & Cells(i, cellcolumn) & pictype(j)) <> "" Then

                         Cells(i, piccolumn) = "MMT"      '表格填图

                         ActiveSheet.Shapes.AddShape(msoShapeRectangle, (Cells(i, piccolumn).Left + 0.5), (Cells(i, piccolumn).Top + 0.5), (Cells(i, piccolumn).Width - 1), (Cells(i, piccolumn).Height - 1)).Fill.UserPicture picads & Cells(i, cellcolumn) & pictype(j)

                         Exit For '插入图片，退出循环

                      End If

          Next j

    Next i

    ActiveSheet.Shapes.SelectAll

    Selection.ShapeRange.Line.Visible = msoFalse '设置矩形对象无边框

    Application.ScreenUpdating = True

   Range("a1").Select

End Sub

4、效果如下：