Sub Resim_Ekle()
Application.Volatile
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
ActiveSheet.DrawingObjects.Delete
Sayfa2.Range("B:B,F:F,J:J,N:N,R:R").ClearContents
dip = Sayfa1.Cells(Rows.Count, "A").End(3).Row
sat = 2: sut = 3
For i = 2 To Sayfa1.Range("A65536").End(3).Row
For Each resim In fso.getfolder(ThisWorkbook.Path & "\resim\").Files
foto = resim.Name
listedekifoto = Replace(Sayfa1.Cells(i, "A").Value, "/", "") & " (" & Sayfa1.Cells(i, "B").Value & ").JPG"
If listedekifoto = foto Then
Set fotom = ActiveSheet.Pictures.Insert(CStr(resim))
With fotom
.ShapeRange.LockAspectRatio = msoFalse
.Width = Sayfa2.Range(Sayfa2.Cells(sat, sut), Sayfa2.Cells(sat + 5, sut + 1)).Width
.Height = Sayfa2.Range(Sayfa2.Cells(sat, sut), Sayfa2.Cells(sat + 5, sut + 1)).Height
.Top = Sayfa2.Rows(Sayfa2.Cells(sat, sut).Row).Top
.Left = Sayfa2.Columns(Sayfa2.Cells(sat, sut).Column).Left
.Placement = xlFreeFloating
Sayfa2.Cells(sat + 1, sut - 1).Value = Sayfa1.Cells(i, "C").Value
Sayfa2.Cells(sat + 2, sut - 1).Value = Sayfa1.Cells(i, "D").Value
Sayfa2.Cells(sat + 3, sut - 1).Value = Sayfa1.Cells(i, "A").Value
Sayfa2.Cells(sat + 4, sut - 1).Value = Sayfa1.Cells(i, "B").Value
sut = sut + 4
If sut > 19 Then
sut = 3
sat = sat + 8
End If
End With
End If
Next resim
Next i
MsgBox "İşlem Tamamlandı.", vbInformation, "Www.ExcelTurkey.Com"
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub