EXCLE批量插入图片VBA代码

输入入下vba代码：

Sub 批量插入图片()

Dim address As String

Dim cellcolumn, piccolumn As Integer

On Error Resume Next '容错处理

address = “E:\商品图片” '图片文件夹所在的位置，根据图片位置修改

cellcolumn = 1 '设置款号所在列，根据自己实际情况修改

piccolumn = 11 '设置插入图片所在第几列，根据自己实际情况修改

Application.ScreenUpdating = False ’关闭屏幕更新，提升速度

For I = 2 To Range(“A65536”).End(xlUp).Row '数字2是设置开始填充图片的行号是第二行，根据实际情况修改

        Cells(I, piccolumn).Select

        Cells(I, piccolumn) = Cells(I, cellcolumn) '图片所在单元格必须有数据才能支持排序

   ActiveSheet.Shapes.AddShape(msoShapeRectangle, (Cells(I, piccolumn).Left + 2.5), (Cells(I, piccolumn).Top + 2), (Cells(I, piccolumn).Width - 5), (Cells(I, piccolumn).Height - 4)).Fill.UserPicture address & "\" & Cells(I, cellcolumn).Text & ".jpg" '填充图片 '图片格式必须为*.jpg格式，如果为其他格式，在这里更改图片格式

                    

        Selection.ShapeRange.LockAspectRatio = msoTrue

        Selection.ShapeRange.Rotation = 0#

        Selection.Placement = xlMoveAndSize 

        Selection.PrintObject = True

Next I

Application.ScreenUpdating = True '打开屏幕更新

End Sub