Sub insertPic()
' Dir函数批量获取指定目录下所有文件名和内容
On Error Resume Next
Application.ScreenUpdating = False
Dim MR As Range
For Each MR In Selection
If Not IsEmpty(MR) And Dir(ActiveWorkbook.Path & "\" & MR.Value & ".JPG") <> "" Then
MR.Select
ML = MR.Left
MT = MR.Top
MW = MR.Width
MH = MR.Height
ActiveSheet.Shapes.AddShape(msoShapeRectangle, ML, MT, MW, MH).Select
Selection.ShapeRange.Fill.UserPicture _
ActiveWorkbook.Path & "\" & MR.Value & ".JPG"
End If
Next
Set MR = Nothing
Application.ScreenUpdating = True
End Sub
3、关闭VBA窗口,Excel-视图-宏-查看宏;
6、图片自动插入对应的单元格中,也即:C列。(图片尺寸均可通过单元格大小进行调整,边框可设置)