根据文件名自动插入本地图片到Excel，并对齐单元格

Sub PicturesInsert()
Attribute PicturesInsert.VB_ProcData.VB_Invoke_Func = "f \n14"

Dim i, arr, str, typ, shp

On Error Resume Next ‘忽略运行中可能出现的错误

Application.ScreenUpdating = False ‘关闭工作表更新，提高运行速度

Set mysheet1 = ThisWorkbook.Worksheets("Sheet1") ‘定义Sheet1工作表

arr = Array(".jpg", ".jpeg", ".png", ".bmp", ".gif", ".tif") ‘图片格式集合

For Each shp In mysheet1.Shapes

If shp.Left > mysheet1.Columns("A").Left And shp.Left < mysheet1.Columns("C").Left Then

shp.Delete ‘如果是E列单元格里边的图片，则删除

End If

Next

For i = 2 To 1000 ‘从第2行到1000行 （如果标题栏有1栏，这里就是2 to 100，有2栏改为3）

If mysheet1.Cells(i, 1) <> "" Then ‘如果A列对应的单元格不为空白，则执行

For Each typ In arr ‘执行图片格式组里面的每一个尝试

str = "\\192.168.1.100\Pictures\" & mysheet1.Cells(i, 1).Value & typ ‘图片路径 (“1”代表图片的名称在第1列)

If Dir(str) <> "" Then ‘如果图片存在，则执行

mysheet1.Pictures.Insert(str).Select ‘插入图片并选择

With Selection.ShapeRange

.LockAspectRatio = msoFalse ‘不锁定图片的比例

.Height = mysheet1.Cells(i, 2).Height - 4 ‘图片的高度设为单元格高度-4 （“2”代表存放图片到第2列）

.Width = mysheet1.Cells(i, 2).Width - 4 ‘图片的宽度设为单元格高度-4

.Top = mysheet1.Cells(i, 2).Top + 2 ‘图片的位置为E列对应单元格到顶部的距离+2

.Left = mysheet1.Cells(i, 2).Left + 2 ‘图片的位置为E列对应单元格到左侧的距离+2

End With

mysheet1.Cells(i, 2) = "" ‘清空E列对应单元格的内容

Exit For ‘导入图片后，退出For循环

Else

mysheet1.Cells(i, 2) = "图片不存在" ‘否则将显示“图片不存在”

End If

Next

End If

Next

mysheet1.Cells(i + 1, 2).Select

Application.ScreenUpdating = True ‘恢复更新显示

End Sub

根据文件名自动插入本地图片到Excel，并对齐单元格

原文：https://www.cnblogs.com/lmh6825/p/14584712.html