klasördeki dosya ve sayfa listesini oluşturma

C

cimbom05

Katılım
27 Aralık 2008
Mesajlar
131
Excel Vers. ve Dili
Excel 2007 & 2003 Türkçe
İyi akşamlar,
Bir klasör içerisinde farklı dosya isimlerine sahip ecel dosyaları mevcut ve her bir dosya içerisinde farklı isimlerde ve farklı sayılarda sayfalar bulunmaktadır. Oluşturacağımız bir indeks dosyasında
- Klasör içerisindeki dosya isimlerini A sütununa
- Her bir dosya içerisinde bulunan sayfaların isimlerini aynı satırda B:Z sütunlarına listelemek istiyorum.
Bu işlemi makro ile yapmak mümkün müdür?
Soru ile ilişkili olarak klasörü ekliyorum. Klasör içerisindeki indeks.xls dosyası oluştumak istediğim indeks.xls dosyasıdır.
 

Ekli dosyalar

J

janveljan

Katılım
27 Temmuz 2004
Mesajlar
719
Excel Vers. ve Dili
Excel 2003 Tr
Dosya ve sayfalarını listeyen bir dosya hazırladım, dosya ve sayfa isimlerine köprü de kuruyor isterseniz o kısımları kodlardan çıkarabilirsiniz.
 

Ekli dosyalar

C

cimbom05

Katılım
27 Aralık 2008
Mesajlar
131
Excel Vers. ve Dili
Excel 2007 & 2003 Türkçe
Sayın janjelvan çok teşekkür ederim. Ayrıca linkler konuyu oldukça süslemiş. Emeğinize sağlık.
 
C

cebelitarık

Katılım
12 Kasım 2007
Mesajlar
327
Excel Vers. ve Dili
excel 2003
Sayın janjelvan çok teşekkür ederim.
Kodlar benimde işime yaradı. Ancak indekslenecek klasörü tesbit edecek bir windows penceresi eklenebilirmi?
 
J

janveljan

Katılım
27 Temmuz 2004
Mesajlar
719
Excel Vers. ve Dili
Excel 2003 Tr
cebelitarık' Alıntı:
Sayın janjelvan çok teşekkür ederim.
Kodlar benimde işime yaradı. Ancak indekslenecek klasörü tesbit edecek bir windows penceresi eklenebilirmi?
Genişletmek için tıkla ...
İndeksleme yapılacak klasör yolunu seçmek için, pencere eklendi.

Kod: 
Sub fihrist()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Range("A2:N50").ClearContents
    'On Error GoTo hata
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Index = ActiveWorkbook
    
    Set Yol = CreateObject("Shell.Application").BrowseForFolder _
                    (0, "Lütfen bir klasor seçin !", 1)
    If Not TypeName(Yol) = "Nothing" Then Set YolItem = Yol.self
    MyPath = YolItem.Path
    'Set MyPath = ActiveWorkbook.Path
    
    sat = 1
    For Each dosya In FSO.GetFolder(MyPath).Files
        uzanti = FSO.GetExtensionName(MyPath & dosya.Name)
        If uzanti = "xls" And dosya.Name <> "indeks.xls" Then
        Set hedef = Workbooks.Open(MyPath & "\" & dosya.Name)
        hedef.Activate
        sat = sat + 1
        Index.Sheets("Sayfa1").Cells(sat, 1) = Mid(dosya.Name, 1, Len(dosya.Name) - 4)
        Index.Sheets("Sayfa1").Hyperlinks.Add _
        Anchor:=Index.Sheets("Sayfa1").Cells(sat, 1), Address:=dosya.Name
        For i = 1 To hedef.Sheets.Count
        Index.Sheets("Sayfa1").Cells(sat, i + 1) = Sheets(i).Name
        Index.Sheets("Sayfa1").Hyperlinks.Add _
        Anchor:=Index.Sheets("Sayfa1").Cells(sat, i + 1), Address:=dosya.Name, _
        SubAddress:="'" & Sheets(i).Name & "'!A1"
        Next
        hedef.Close
        End If
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Exit Sub
hata:
    MsgBox "Bir hata ile karşılaşıldı.", vbCritical, "Hata"
End Sub
 

Ekli dosyalar

C

cebelitarık

Katılım
12 Kasım 2007
Mesajlar
327
Excel Vers. ve Dili
excel 2003
Sayın Janveljan
Kodlar için teşekkür ederim.
Ancak küçük bir ilave daha istesem mümkünmüdür.
Belirlediğimiz klasör içerinde xls. Dosyaları dışında xls. ,doc., Jpg. veya başka uzantılı dosyalarda varsa onların isimlerini A sütununa sıralayabilir mi?
 
J

janveljan

Katılım
27 Temmuz 2004
Mesajlar
719
Excel Vers. ve Dili
Excel 2003 Tr
Diğer dosyalarıda ekleyen kodları ekledim, kodlar iki alternatifli, isterseniz belli uzantıları seçerek onları listeletebilir, yada diğer satırı kullanıp tüm dosyaları listeletebilirsiniz.

Kod: 
Sub fihrist()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Range("A2:N50").ClearContents
    'On Error GoTo hata
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Index = ActiveWorkbook
    
    Set Yol = CreateObject("Shell.Application").BrowseForFolder _
                    (0, "Lütfen bir klasor seçin !", 1)
    If Not TypeName(Yol) = "Nothing" Then Set YolItem = Yol.self
    MyPath = YolItem.Path
    'Set MyPath = ActiveWorkbook.Path
    
    sat = 1
    For Each dosya In FSO.GetFolder(MyPath).Files
        uzanti = FSO.GetExtensionName(MyPath & dosya.Name)
        If uzanti = "xls" And dosya.Name <> "indeks.xls" Then
        Set hedef = Workbooks.Open(MyPath & "\" & dosya.Name)
        hedef.Activate
        sat = sat + 1
        Index.Sheets("Sayfa1").Cells(sat, 1) = Mid(dosya.Name, 1, Len(dosya.Name) - 4)
        Index.Sheets("Sayfa1").Hyperlinks.Add _
        Anchor:=Index.Sheets("Sayfa1").Cells(sat, 1), Address:=dosya.Name
        For i = 1 To hedef.Sheets.Count
        Index.Sheets("Sayfa1").Cells(sat, i + 1) = Sheets(i).Name
        Index.Sheets("Sayfa1").Hyperlinks.Add _
        Anchor:=Index.Sheets("Sayfa1").Cells(sat, i + 1), Address:=dosya.Name, _
        SubAddress:="'" & Sheets(i).Name & "'!A1"
        Next
        hedef.Close
        End If
    Next
    For Each dosya In FSO.GetFolder(MyPath).Files
        uzanti = FSO.GetExtensionName(MyPath & dosya.Name)
        If uzanti = "doc" Or uzanti = "jpg" Or uzanti = "txt" Then 'istenen uzantı buraya eklenerek sıralamaya dahil edilebilir.
        'If uzanti <> "xls" Then ' Üstteki satır yerine bu satır kullanılırsa xls dosyalarının ardından geri kalan tüm dosyalar listelenir.
        sat = sat + 1
        Index.Sheets("Sayfa1").Cells(sat, 1) = Mid(dosya.Name, 1, Len(dosya.Name) - 4)
        Index.Sheets("Sayfa1").Hyperlinks.Add _
        Anchor:=Index.Sheets("Sayfa1").Cells(sat, 1), Address:=dosya.Name
        End If
    Next

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Exit Sub
hata:
    MsgBox "Bir hata ile karşılaşıldı.", vbCritical, "Hata"
End Sub
 
A

arşivist1

Katılım
30 Aralık 2008
Mesajlar
226
Excel Vers. ve Dili
OFİS 2010
güzel program elinize sağlık

bir de kitapların içindeki bilgileri kopyalayıp yeni kitapta birleştirebilirmiyiz
 
3

3641

Altın Üye
Katılım
22 Mayıs 2006
Mesajlar
134
Altın Üyelik Bitiş Tarihi
27-10-2026
Sn. janveljan
Arkadaşların İsteklerine göstermiş olduğunuz ilgi ve alakaya sığınarak,

Klasör içindeki dosyaları indekslerken A1 Hücesindeki bilgi ile Hücre Adı "Gk" olan bilgileride sıralatmamız mümkünmü acaba.

Saygılarımla,
 
J

janveljan

Katılım
27 Temmuz 2004
Mesajlar
719
Excel Vers. ve Dili
Excel 2003 Tr
arşivist' Alıntı:
güzel program elinize sağlık

bir de kitapların içindeki bilgileri kopyalayıp yeni kitapta birleştirebilirmiyiz
Genişletmek için tıkla ...
3641' Alıntı:
Sn. janveljan
Arkadaşların İsteklerine göstermiş olduğunuz ilgi ve alakaya sığınarak,

Klasör içindeki dosyaları indekslerken A1 Hücesindeki bilgi ile Hücre Adı "Gk" olan bilgileride sıralatmamız mümkünmü acaba.

Saygılarımla,
Genişletmek için tıkla ...
Arkadaşlar bende sizin affınıza sığınarak, bu konuyu daha fazla dallandırıp budaklandırmadan burada kesmek istiyorum, zira açılan konu başlığından uzaklaşmaya başladık. Bu istekleriniz ayrı bir mesaj konusu olabilecek sorular. Bu sorularınızı isterseniz foruma soru olarak gönderin hem daha fazla yanıt alabilirsiniz hem de daha sonra buna benzer ihtiyacı olan arkadaşlar çözüme daha kolay ulaşabilecektir.
 
R

Rafet

Altın Üye
Katılım
24 Mart 2005
Mesajlar
230
Excel Vers. ve Dili
Ofice 2010 - Türkçe
Altın Üyelik Bitiş Tarihi
01-12-2025
Konu cok ilgimi cekti.
Yıllar önce daha gençken mp3 arşivi yaparken klasordeki mp3 fisrıhti yapmak için programlar kullanırdım.
Şimdi bu programı kendim yazabilecek duruma geldik .
Nerden nereye.

Tabi klasorun içindeki klsor listesini felanda almamız lazım. Klasorun içinde klasor olmayana kadar devam edecek bu tabi.

CD arşivi programlar var.

Al sana cd arşiv rogramı.
Hemde bir - iki sayfa kodla oalcakmiş gibi.

İşlerimin yoğunluğundan bunu şu an için gercekleşştiremem fakat ilerde bunu inceleyip gerckleitirmek ve excel.web.tr ile paylaşmak iseterim.

Ufkumuzu actığı için konuyu başlatan ve devam ettiren arkadaşlara cok teşekkürler.

Muhabetle.
 
S

selo1234

Katılım
17 Aralık 2008
Mesajlar
96
Excel Vers. ve Dili
excel 2010 türkçe
Eline sağlık Janveljan,
Çok güzel bir çalışma olmuş, ben bunu biraz amacıma uygun oynamak istedim. İlgili excel sayfalarını 2.sutuna alt alta yazdırıp, o excel sayfanın içindeki sutunlara toplam, düşeyara gibi formüller koymak istedim.
Fakat Başarılı olamadım.
Üzerinde oynama yaptığım sizin dosyayı ekte gönderiyorum.
Yardımcı olursanız sevinirim.
İyi çalışmalar
 

Ekli dosyalar

H

hsayar

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Set FSO = CreateObject("Scripting.FileSystemObject")

Satırı vista ve Ofis2007 de çalışmıyor mu?
 
S

selo1234

Katılım
17 Aralık 2008
Mesajlar
96
Excel Vers. ve Dili
excel 2010 türkçe
Merhaba Arkadaşlar,
Bu güzel çalışmada aşağıdaki eklemeyi yapmak istedim.

Index.Sheets("Sayfa1").Cells(sat, 3).Formula = "=sum( 'Sheets(i).Name'!O:O)"

Fakat, Sayfa1 3. sutuna o sayfadan toplam aldırmak için topla formulü koymak istiyorum ama 'Sheets(i).Name' ile ilgili sayfanın adını aldıramıyorum.
Sanırım küçük bir hata yapıyorum ama çözemedim.
Yardımcı olursanız çok memnun olacağım, takıldım kaldım, şimdiden çok teşekkürler.
 
J

janveljan

Katılım
27 Temmuz 2004
Mesajlar
719
Excel Vers. ve Dili
Excel 2003 Tr
Muhtemelen şöyle olmalı.
Index.Sheets("Sayfa1").Cells(sat, 3).Formula = "=sum( 'Sheets(" & i & ").Name'!O:O)"
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst