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