Resmi istediğimiz satıra getirmek

[cetin1254]

benım sorunum su bılen arkadaslarımız yardımcı olurlarsa sevınırım

en cok satan unurlerın yanlarına resımlerını koymak ıstıyorum tum resımler mevcut ama tek tek koymak ıstemıyorum ustelık dusey ara yaptıgımda resımlerın satıra sabıt kalmasını ıstıyorum ama yapamıyorum cunku resımlerı hucrelere yerlestıremıyorum .acaba bu resımlerı bır formulle yada makroyla nasıl bu satırlara getırebılır ve dusey ara yada a dan z ye sıraladıgımda hala yanlarında kalmasını saglarım tesekkurlerr ..

 

[1Al2Ver]

Merhaba,

2003 formatında örnekli bir dosya eklemenizi öneririm, böylece hem daha çabuk, hem de doğru çözüm alabilirsiniz, diğer şekliyle zor olur, çünkü sizin veri aralıklarınız, örnek dosya olmadan buradan üretilenlerle örtüşmeyebilir,

Teşekkür ederim.

 

[cetin1254]

sayın 1al2ver sanırım sorunum cozumunu buldum fakar ufak bır ayrıntıyı halledemedım

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 + 1, sutun) = dosya
dosya = Dir
If sutun = 1 Then
sutun = 1
konum_ust = konum_ust + Cells(satir, sutun).Height
konum_ust = konum_ust + Cells(satir + 1, sutun).Height
satir = satir + 2
konum_sol = 0
Else
konum_sol = konum_sol + Cells(satir, sutun).Width
sutun = sutun + 1
End If


Wend



End Sub

kodlarıyla resımlerı alıyorum hatta ıstedıgım gıbı fıltredede kullanıyorum ama ekte yukledıgım excelde sayfa uctekı gıbı dosya ısımlerının resmın altındakı satıra degıl sag tarafındakı sutuna gelmesını ıstıyorum ve beceremedım yardımcı olursanız sevınırım tesekkurler..

 

[cetin1254]

tmm o sorunuda cosdum kurcalıya kurcalıya fakat bu sefer de resımler hucrelere oturmuyor

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 = 115
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 = 125

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

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


Wend




End Sub

yardımcı olursanız sevınırım..

 

[cetin1254]

:kafa: dort saattır bununla ugrasıyorum ve aglamak ıstıyorum artık ........