not: ilk resmin şablon olduğunu düşündüğümden bütün resimleri silip öyle dener misiniz?
Şekil ekleme Kodu
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
