作者：乔山办公网日期：
返回目录：excel表格制作
试试e79fa5e98193e59b9ee7ad94337这样
Sub InsertPic()
On Error Resume Next
Dim i As Long, sPath As String, sfileName As String
sPath = "D:\pic\"
Application.ScreenUpdating = False
For i = 2 To Cells(65536, 1).End(xlUp).Row
If Cells(i, 1) <> "" Then
sfileName = sPath & Cells(i, 1) & ".jpg"
With Cells(i, 2)
ActiveSheet.Shapes.AddPicture sfileName, True, True, .Left, .Top, .Width, .Height
End With
End If
Next i
Application.ScreenUpdating = True
Range("A1").Select
End Sub
没有这样的事件，只有想办法变通了
这里图片的扩展名是PNG， 你需要改成你当前图片的扩展名
"D:\360data\重要数据\我的文档\图片\" 这个路径你改成你图片的路径
图片随单元格大小变化
你如果名称里面本身就带扩真名 & ".png " 代码中的扩展名这个去掉就可以了e79fa5e98193e58685e5aeb9336 ，只需要改下图片保存路径
Sub 图片批量导入()
Dim r!
Dim s As Shape
Dim rng As Range
On Error Resume Next
r = ActiveSheet.[a65536].End(3).Row
For Each s In ActiveSheet.Shapes
If s.Type <> 8 Then s.Delete
Next
For Each rng In Range("B1:B" & r)
ActiveSheet.Shapes.AddShape(msoShapeRectangle, rng.Left, rng.Top, rng.Width, rng.Height).Select
Selection.ShapeRange.Fill.UserPicture "D:\360data\重要数据\我的文档\图片\" & rng.Offset(0, -1).Text & ".png "
Next
End Sub