|
Sub 插入照片()
Application.ScreenUpdating = False
rr = Array(2, 6, 10)
For Each sh In Sheets
For Each sp In sh.Pictures
sp.Delete
Next sp
sh.Select
n = 0
For i = 0 To UBound(rr)
n = n + 1
f = Dir(ThisWorkbook.Path & "\" & n & ".png")
If f <> "" Then
r = rr(i)
sh.Range(sh.Cells(34, r), sh.Cells(35, r + 1)).Select
sh.Pictures.Insert(ThisWorkbook.Path & "\" & f).Select
Selection.ShapeRange.LockAspectRatio = msoFalse
With Selection.ShapeRange
Selection.ShapeRange.LockAspectRatio = msoFalse
.Top = sh.Range(sh.Cells(34, r), sh.Cells(35, r + 1)).Top + 1
.Left = sh.Range(sh.Cells(34, r), sh.Cells(35, r + 1)).Left + 1
.Width = sh.Range(sh.Cells(34, r), sh.Cells(35, r + 1)).Width
.Height = sh.Range(sh.Cells(34, r), sh.Cells(35, r + 1)).Height
End With
End If
Next i
Next sh
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub
|
|