Aşağıda, bir dizindeki tüm kapalı çalışma kitaplarını ve çalışma sayfalarını dolaşan ve tüm adları görüntüleyen Excel VBA'daki bir programa bakacağız.
"C:\excel\" içinde kitap1.xlsx, kitap2.xlsx, kitap3.xlsx, kitap4.xlsx ve kitap5.xlsx adında dosyalar yaratın.
Durum:
Komut düğmesine aşağıdaki kod satırlarını ekleyin:
1. İlk olarak, String türünde iki değişken, bir Worksheet nesnesi ve Integer türünde iki değişken tanımlıyoruz.
Dim dizin As String, dosyaAdi As String, sayfa As Worksheet, i As Integer, j As Integer
2. Ekran titremesini önlemek için ekran güncellemesini kapatın.
Application.ScreenUpdating = False
3. Değişken dizini başlatın. Dizinde yer alan ilk *.xl?? dosyasını bulmak için Dir işlevini kullanırız.
dizin = "C:\excel\" dosyaAdi = Dir(dizin & "*.xl??")
Not: Dir işlevi, tüm farklı Excel dosyalarını aramak için birden çok karakter (*) ve tek karakter (?) joker karakterlerinin kullanımını destekler.
4. dosyaAdi değişkeni artık dizinde bulunan ilk Excel dosyasının adını tutar. Do while Döngüsü ekleyin.
Do While dosyaAdi <> "" Loop
Aşağıdaki kod satırlarını (5, 6, 7, 8 ve 9'da) Do While Loop döngüsü içine ekleyin.
5. Tamsayı türündeki değişkenleri sıfırlayın ve Excel dosyasının adını i satırının ilk sütununa ekleyin.
i = i + 1 j = 2 Cells(i, 1) = dosyaAdi
6. Kapalı Excel dosyalarından verileri (veya sayfa adlarını) çıkarmanın basit bir yolu yoktur. Bu nedenle, Excel dosyasını açıyoruz.
Workbooks.Open (dizin & dosyaAdi)
7. Excel dosyasının tüm sayfa adlarını i satırının diğer sütunlarına ekleyin.
For Each sayfa In Workbooks(dosyaAdi).Worksheets Workbooks("kitap1.xlsm").Worksheets(2).Cells(i, j).Value = sayfa.Name j = j + 1 Next sayfa
8. Excel dosyasını kapatın.
Workbooks(dosyaAdi).Close
9. Dir işlevi özel bir işlevdir. Diğer Excel dosyalarını almak için Dir işlevini tekrar argüman olmadan kullanabilirsiniz.
dosyaAdi = Dir()
Not: başka dosya adı eşleşmediğinde, Dir işlevi sıfır uzunluklu bir dize ("") döndürür. Sonuç olarak, Excel VBA Do while döngüsünden çıkar.
10. Ekran güncellemesini tekrar açın (döngünün dışında, loop komutundan sonraki satıra).
Application.ScreenUpdating = True
11. Programı test edin.
Sonuç:
Tüm kodlar:
Dim dizin As String, dosyaAdi As String, sayfa As Worksheet, i As Integer, j As Integer Application.ScreenUpdating = False dizin = "C:\excel\" dosyaAdi = Dir(dizin & "*.xl??") Do While dosyaAdi <> "" i = i + 1 j = 2 Cells(i, 1) = dosyaAdi Workbooks.Open (dizin & dosyaAdi) For Each sayfa In Workbooks(dosyaAdi).Worksheets Workbooks("kitap1.xlsm").Worksheets(2).Cells(i, j).Value = sayfa.Name j = j + 1 Next sayfa Workbooks(dosyaAdi).Close dosyaAdi = Dir() Loop Application.ScreenUpdating = True End Sub
