1、原表是这样的,根据A列款号,把相对应的图片填充到k列
2、excel中打开visual basic 编辑器,插入-插入模块
3、Sub a竖排插入图片()Dim cellcolumn As StringDim piccolumn As StringDim shp As ShapeDim pictype(1 To 3) As StringDim picads As StringDim i, j, k As LongOn 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").SelectEnd Sub
4、效果如下: