Link olarak ekler
Sub RsmEkle()
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)
'mod yerine: TmpKalan = TmpSay Mod Taban ==> TmpKalan = TmpSay - Taban * Fix(TmpSay / Taban)
x = 0
Set Rng = ws.Range("J21")
Do While Len(fName) > 0
imagePath = fPath & fName
StrKay = Fix(x / 2)
StnKay = x - 2 * Fix(x / 2)
With ws.Pictures.Insert(imagePath)
With .ShapeRange
.LockAspectRatio = msoFalse
.Width = imgWidth
.Height = imgHeight
End With
.Left = Rng.Offset(StrKay, StnKay).Left + ekleLeft
.Top = Rng.Offset(StrKay, StnKay).Top + ekleTop
.Placement = 1
.PrintObject = True
End With
x = x + 1
fName = Dir 'sonrak dosya adını al
Loop
End Sub
