dıs bı klasorden excele resım almak

[cetin1254]

arkadaslar asagıda verdıgım kodlarda resımler a sutununda alt alta dıs bır klasorden alınıp hucreye sıgdırılıyor super bır olay kaynak yıne bu sıtedekı ustadlarımız. fakat ne kadar ugrasmama ragmen resımlerın arasında cıkan satırı yok edemedım ve dosya ısımlerını B sutununa tasıyamadım arkadaslar yardımcı olursanız sevınırım . tesekkurler emegınıze saglık..

 

[cetin1254]

Sub dizindeki_tum_resimleri_excele_ekleme()
Dim dosya
Dim i As Integer
dizin = "c:\users\public\pictures\sample Pictures\"
dosya = Dir(dizin & "*.jpg")
satir = 1
sutun = 1
resim_genislik = 60
resim_yukseklik = 110
konum_sol = Cells(satir, sutun).Width * (sutun - 1)
konum_ust = Cells(satir, sutun).Height * (satir - 1)
While dosya <> ""

Cells(satir, sutun).ColumnWidth = 12
Cells(satir, sutun).RowHeight = 115

ActiveSheet.Shapes.AddPicture dizin & [dosya], True, True, konum_sol + 4, konum_ust + 4, resim_genislik, resim_yukseklik

Application.Wait Now + TimeValue("00:00:01")
Cells(satir, sutun) = dosya
dosya = Dir
If sutun = 1 Then
sutun = 1
konum_ust = konum_ust + Cells(satir, sutun).Height
konum_ust = konum_ust + Cells(satir + 2, sutun).Height
satir = satir + 2
konum_sol = 2
Else
konum_sol = konum_sol + Cells(satir, sutun).Width
sutun = sutun
End If


Wend



End Sub

kodu yazmayı unutmusum bu arada