Merhaba aşağıdaki kod yardımı ile F sütunundaki hücrelerde yer alan isimlere göre dosyaları B sütununda klasörden çekip listeletiyoruz. Fakat nedendir bilmiyorum 154. satırdan sonra işlem duruyor. Sonrasında da hiç bir tanesi gelmiyor fakat klasörde çoğunun dosyası mevcut olmayanları yukarıda zaten atlıyordu. Fakat buradan sonra olan da olmayan da gelmiyor. http://prntscr.com/ra8oeh neden olabilir acaba?
Kod:
Sub Demo1()
resimyolu = ThisWorkbook.Path & "\FOTOLAR\"
Sayfa1.OLEObjects.Delete
sat = [a100000].End(3).Row
For s = 2 To sat
DoEvents
If Dir(resimyolu & Cells(s, "f") & ".jpeg") <> "" Then uzanti = ".jpeg"
If Dir(resimyolu & Cells(s, "f") & ".jpg") <> "" Then uzanti = ".jpg"
If uzanti <> "" Then
Set p = ActiveSheet.OLEObjects.Add( _
ClassType:="Forms.Image.1", _
Left:=Cells(s, "b").Left + 3, _
Top:=Cells(s, "b").Top + 3, _
Width:=Cells(s, "b").Width - 6, _
Height:=Cells(s, "b").RowHeight - 6)
Set r = p.Object
r.PictureSizeMode = fmPictureSizeModeStretch
r.Picture = LoadPicture(resimyolu & Cells(s, "f") & uzanti)
End If
uzanti = ""
Next
End Sub
