Belli Bir Dizin'deki Resimlerin sadece isimlerini almak

[1Al2Ver]

Merhaba,

D:\Resimler\YemekResimleri\Yemekler.jpg ' de kayıtlı .jpg uzantılı resimlerin sadece isimlerini, bir excel sayfasında (örn; L sütundan başlayarak), alfabetik olarak ve 25'erli gruplar halinde, almak.

Teşekkür ederim.

 

[Ayhan Ercan]

Merhaba

Aşağıdaki Kodu deneyiniz...

Sub DENEME()
Dim dosya, i As Integer
dosya = Dir("D:\RESİMLER\Yemek Resimleri\YEMEKLERJPG\*.jpg")
i = 1
    While dosya <> ""
        Cells(i, "L") = dosya
        dosya = Dir
        i = i + 1
    Wend
End Sub

 

[Merhum İdris SERDAR]

DOS command window penceresinde:

dir D:\Resimler\YemekResimleri\ >c:\dosyalistesi.txt

yazarak dosyalarınızın adını dosyalistesi adındaki bir text dosyasına alın. Sonra Excel ile bu dosyayı açın.

.

 

[1Al2Ver]

Merhaba

Aşağıdaki Kodu deneyiniz...

Sub DENEME()
Dim dosya, i As Integer
dosya = Dir("D:\RESİMLER\Yemek Resimleri\YEMEKLERJPG\*.jpg")
i = 1
    While dosya <> ""
        Cells(i, "L") = dosya
        dosya = Dir
        i = i + 1
    Wend
End Sub

Sayın Ayhan Ercan, merhaba ve teşekkür ederim,

Kod, verileri "L" sütununa, alfabetik olarak sıraladı,

Zaman bulduğunuzda "L" için 25 satır "M" için 25 satır "N" için 25 satır gibi, her 25 satırda bir yandaki kolona yazdırabilecek kodu oluşturursanız memnun olurum.

Herşey gönlünüzce olsun, saygılarımla.

 

[1Al2Ver]

DOS command window penceresinde:

dir D:\Resimler\YemekResimleri\ >c:\dosyalistesi.txt

yazarak dosyalarınızın adını dosyalistesi adındaki bir text dosyasına alın. Sonra Excel ile bu dosyayı açın.

.

Sayın Yurttas, ilginiz için teşekkür ederim, sağolun, saygılar sunarım.

 

[Ayhan Ercan]

Sayın Ayhan Ercan, merhaba ve teşekkür ederim,

Kod, verileri "L" sütununa, alfabetik olarak sıraladı,

Zaman bulduğunuzda "L" için 25 satır "M" için 25 satır "N" için 25 satır gibi, her 25 satırda bir yandaki kolona yazdırabilecek kodu oluşturursanız memnun olurum.

Herşey gönlünüzce olsun, saygılarımla.

Merhaba Sayın 1Al2Ver

Aşağıda kodda ilave edilmiş satırlar kırmızı olarak (açıklamalarıyla) belirtilmiştir..
Mavi Satır ise Hücrelere sadece isimlerin gelmesini sağlar ( .jpg Uzantılarını yazmaz)

Sub DENEME()
Dim dosya, i As Integer
dosya = Dir("D:\RESİMLER\Yemek Resimleri\YEMEKLERJPG\*.jpg")
i = 1
[COLOR=red][B]j = 12  [COLOR=#2e8b57]' 12, "L" nin Sütun Sayısı[/COLOR][/B][/COLOR]
    While dosya <> ""
        [COLOR=red][B][COLOR=royalblue]Cells(i, j) = Left(dosya, WorksheetFunction.Find(".", dosya, 2) - 1)[/COLOR] [/B][/COLOR]
        dosya = Dir
        i = i + 1
        [B][COLOR=red]If i = 25 Then j = j + 1: i = 1 [/COLOR][COLOR=seagreen]' i sat&#305;r say&#305;s&#305;d&#305;r. i = 25 oldu&#287;unda j sayac&#305;n&#305; (L s&#252;t&#252;n say&#305;s&#305;n&#305;) 1 art&#305;r, i (sat&#305;r say&#305;s&#305;)'i tekrar 1' e d&#246;nd&#252;r[/COLOR][/B]
    Wend
End Sub

 

[1Al2Ver]

Merhaba Sayın 1Al2Ver

Aşağıda kodda ilave edilmiş satırlar kırmızı olarak (açıklamalarıyla) belirtilmiştir..
Mavi Satır ise Hücrelere sadece isimlerin gelmesini sağlar ( .jpg Uzantılarını yazmaz)

Sub DENEME()
Dim dosya, i As Integer
dosya = Dir("D:\RESİMLER\Yemek Resimleri\YEMEKLERJPG\*.jpg")
i = 1
[COLOR=red][B]j = 12  [COLOR=#2e8b57]' 12, "L" nin Sütun Sayısı[/COLOR][/B][/COLOR]
    While dosya <> ""
        [COLOR=red][B][COLOR=royalblue]Cells(i, j) = Left(dosya, WorksheetFunction.Find(".", dosya, 2) - 1)[/COLOR] [/B][/COLOR]
        dosya = Dir
        i = i + 1
        [B][COLOR=red]If i = 25 Then j = j + 1: i = 1 [/COLOR][COLOR=seagreen]' i satır sayısıdır. i = 25 olduğunda j sayacını (L sütün sayısını) 1 artır, i (satır sayısı)'i tekrar 1' e döndür[/COLOR][/B]
    Wend
End Sub

Sayın Ayhan Ercan, tekrar merhaba, elinize sağlık, kod gayet güzel işlemekte, emek ve ilginiz için teşekkür ederim, saygılarımla.

 

[Bagcivan]

Arkadaşlar konuyla ilgili degil ama benim bir sualim olucaktı şimdi bu kodları alt+11 yapıp vba ya geçtikten sonra nereye yazıyoruz yani solda gorunen sayfa1 2... olan yere mi ?