|
|
Sub 填充照片()
Application.ScreenUpdating = False
Dim x, k As Integer
Dim fs1$
For Each a In Sheet1.Pictures
a.Delete
Next
k = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
For x = 2 To k
fs1 = ThisWorkbook.Path & "图片" & CStr(Sheet1.Cells(x, 1)) & ".jpg"
If Dir(fs1) <> "" Then
Sheet1.Select
Sheet1.Range("c" & x).Select
ActiveSheet.Pictures.Insert(fs1).Select
With Selection.ShapeRange
Selection.ShapeRange.LockAspectRatio = msoFalse
.Top = Sheet1.Range("c" & x).Top + 1
.Left = Sheet1.Range("c" & x).Left + 1
.Width = Sheet1.Range("c" & x).Width - 1
.Height = Sheet1.Range("c" & x).Height - 1
End With
End If
Next x
Application.ScreenUpdating = True
End Sub |
|
