Bir modüle ekleyin ve resim olan makra çağrılacak.
Resimler klasördeki resim adları ile alınıyor lakin dosya boyutu 55mb oluyor
Bende anlamadım.Silme koduda silmiyor galiba doğru olmasına rağmen.
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 SubSub 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