Sub ImageEkle()

Dim ws As Worksheet
Dim imagePath As String
Dim imgLeft As Double
Dim imgTop As Double

Set ws = ActiveSheet
imagePath = "D:\Desktop\Resimler 2021\images (3).jpg"
imgLeft = 3.7 * ws.Shapes("Resim 2").Left ' ActiveCell.Left
imgTop = ws.Shapes("Resim 2").Top  'ActiveCell.Top
imgWidth = ws.Shapes("Resim 2").Width
imgHeight = ws.Shapes("Resim 2").Height
'Width & Height = -1 means keep original size
'ws.Shapes("Resim 2").Delete
Set shp = ws.Shapes.AddPicture( _
    Filename:=imagePath, _
    LinkToFile:=msoFalse, _
    SaveWithDocument:=msoTrue, _
    Left:=imgLeft, _
    Top:=imgTop, _
    Width:=imgWidth, _
    Height:=imgHeight)
 shp.Name = "DenemeResim"
End Sub

Sub ResimEkle(yol As String, sol As Double, topp As Double, gen As Double, yuk As Double, ad As String)
    Dim obj As OLEObject
    Set obj = ThisWorkbook.Sheets(Sayfa2.Name).OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False,        DisplayAsIcon:=False, _
                            Left:=sol, _
                            Top:=topp, _
                            Width:=gen, _
                            Height:=yuk)
    
    With obj.Object
        .Picture = LoadPicture(yol)
        .PictureSizeMode = fmPictureSizeModeStretch
    End With
    obj.Name = ad
    Set obj = Nothing
End Sub

Sub resimSil(sayfaAd As Worksheet)
    Dim obj As OLEObject
    On Error Resume Next
    For Each obj In sayfaAd.OLEObjects
        If TypeOf obj.Object Is MSForms.Image Then
            obj.Delete
        End If
    Next
     On Error GoTo 0
     Set obj = Nothing
End Sub

Sub resim()
    Dim fso As Object
    On Error Resume Next
    With ThisWorkbook.Sheets(Sayfa2.Name)
        resimSil ThisWorkbook.Sheets(.Name)
        say = 21
        Set fso = CreateObject("Scripting.FileSystemObject")
        For Each file In fso.GetFolder(ThisWorkbook.Path & "\Resimler 2021").Files
            If LCase(fso.GetExtensionName(file)) <> "xlsm" Then
                ResimEkle ThisWorkbook.Path & "\Resimler 2021\" & file.Name, _
                        .Cells(say, "j").Left, .Cells(say, "j").Top, .Cells(say, "j").Width, .Cells(say, "j").Height - 1 _
                       , fso.GetBaseName(file)
                say = say + 1
             End If
        Next
    End With
    On Error GoTo 0
    Set fso = Nothing
End Sub

Sub ShpEkle()

Dim ws As Worksheet
Dim imagePath As String
Dim imgLeft As Double
Dim imgTop As Double
Dim imgWidth As Double
Dim imgHeight As Double

imgWidth = 229.3116
imgHeight = 223.9287
ekleLeft = 15
ekleTop = 16.071418762207

Set ws = ThisWorkbook.Worksheets("Tahkikat Ekleri")
fPath = ThisWorkbook.Path & "\Resimler 2021\"
    fName = Dir(fPath & "*.*")        'dosya ismi listesi
'ilk hücre "J21"
'.Offset (RowOffset, ColumnOffset)
x = 0
With ws.Range("J21")
    Do While Len(fName) > 0
    imagePath = fPath & fName
        ws.Shapes.AddPicture _
                Filename:=imagePath, _
                LinkToFile:=msoFalse, _
                SaveWithDocument:=msoTrue, _
                Left:=.Offset(Fix(x / 2), x Mod 2).Left + ekleLeft, _
                Top:=.Offset(Fix(x / 2), x Mod 2).Top + ekleTop, _
                Width:=imgWidth, _
                Height:=imgHeight
            x = x + 1
            fName = Dir                                      'sonrak dosya adını al
    Loop
End With
End Sub

Sub ShpSil()
Dim shp As Shape
Set ws = ThisWorkbook.Worksheets("Tahkikat Ekleri")
For Each shp In ws.Shapes
  shp.Delete
Next shp
End Sub