关于Shapes大家族

按位置插入图片并调整

Sub test()

'如果出错就下一个'
On Error Resume Next

Dim shp, shp1 As Shape

'开始前先清空之前的图片，防止重叠'
For Each shp1 In Sheet1.Shapes
    shp1.Delete
Next

For i = 2 To 12
Set shp = Sheet1.Shapes.AddPicture("d:\data\" & Range("a" & i) & ".jpg", msoFalse, msoCTrue, Range("d" & i).Left, Range("d" & i).Top, Range("d" & i).Width, Range("d" & i).Height)
shp.Placement = xlMoveAndSize
Next

End Sub

like