Excel VBA 根据图片名称插入对应图片

Sub insertpic() '根据图片名称插入对应图片

Dim r As Long, i As Long

Dim path As String

r = ActiveSheet.[a65536].End(xlUp).Row

path = "E:\家具图片\A客厅" '修改图片所在文件夹路径

For i = 1 To r

If Dir(path & "\" & ActiveSheet.Cells(i, 1) & ".jpg") <> "" Then

With ActiveSheet.Pictures.Insert(path & "\" & ActiveSheet.Cells(i, 1) & ".jpg").ShapeRange

.LockAspectRatio = msoFalse

.Left = ActiveSheet.Cells(i, 2).Left

.Top = ActiveSheet.Cells(i, 2).Top

.Height = ActiveSheet.Cells(i, 2).Height

.Width = ActiveSheet.Cells(i, 2).Width

End With

End If

Next i

End Sub