|
Sub insertPic()
Dim i As Integer
Dim FilPath As String
Dim rng As Range
Dim s As String
For Each myShape In Sheet1.Pictures
myShape.Delete
Next
For i = 3 To Sheet1.Range("a65536").End(3).Row
FilPath = ThisWorkbook.Path & "\" & Sheet1.Cells(i, 1).Text & ".jpg"
If Dir(FilPath) <> "" Then
Sheet1.Pictures.Insert(FilPath).Select
Selection.ShapeRange.LockAspectRatio = msoFalse
With Selection
.Width = Sheet1.Range(Sheet1.Cells(i, 2).Address).Width - 1
.Height = Sheet1.Range(Sheet1.Cells(i, 2).Address).Height - 1
.Top = Sheet1.Range(Sheet1.Cells(i, 2).Address).Top + 1
.Left = Sheet1.Range(Sheet1.Cells(i, 2).Address).Left + 1
End With
End If
Next i
For i = 3 To Sheet1.Range("d65536").End(3).Row
FilPath = ThisWorkbook.Path & "\" & Sheet1.Cells(i, 4).Text & ".jpg"
If Dir(FilPath) <> "" Then
Sheet1.Pictures.Insert(FilPath).Select
Selection.ShapeRange.LockAspectRatio = msoFalse
With Selection
.Width = Sheet1.Range(Sheet1.Cells(i, 5).Address).Width - 1
.Height = Sheet1.Range(Sheet1.Cells(i, 5).Address).Height - 1
.Top = Sheet1.Range(Sheet1.Cells(i, 5).Address).Top + 1
.Left = Sheet1.Range(Sheet1.Cells(i, 5).Address).Left + 1
End With
End If
Next i
End Sub |
|