Kapalı Dosyadaki Sayfa Adlarını Listboxta listeleme

[Feylosof]

Merhaba;
Kapalı olan "İZİN PROGRAMI" adlı dosyada bulunan tüm sayfaları(worksheets) listboxta listelemek istiyorum.
Desteğini esirgemeyen excel dostlarına şimdiden teşekkür ederim.

 

[Korhan Ayhan]

Merhaba,

Forumda catalog ifadesi ile arama yaparsanız sonuçlara ulaşabilirsiniz.

 

[Feylosof]

Merhaba,

Forumda catalog ifadesi ile arama yaparsanız sonuçlara ulaşabilirsiniz.

Eyvallah saygı değer üstadım.

 

[Feylosof]

@Korhan Ayhan Hocam catalog ile arama yapınca epey bir seçenek geldi ama benim kod bilgimle istediğim kodu çıkarmam mümkün görünmemektedir. Saygıyla

 

[Erdem Akdemir]

Merhaba,

Aşağıdaki kodu kullanabilirsiniz.

Private Sub UserForm_Initialize()

    Dim file As String
    Dim sh
    Dim c
    file = "dosya yolu"
    Set sh = GetObject(file).Worksheets
  
    For Each c In sh
    ListBox1.AddItem c.Name
    Next
    
    GetObject(file).Close
    
    Set sh = Nothing

End Sub

 

[Feylosof]

Merhaba,

Aşağıdaki kodu kullanabilirsiniz.

Private Sub UserForm_Initialize()

    Dim file As String
    Dim sh
    Dim c
    file = "dosya yolu"
    Set sh = GetObject(file).Worksheets
 
    For Each c In sh
    ListBox1.AddItem c.Name
    Next
   
    GetObject(file).Close
   
    Set sh = Nothing

End Sub

çok teşekkürler. Hemen deneyeceğim. Varolun.

 

[Korhan Ayhan]

Alternatif;

Option Explicit

Private Sub UserForm_Initialize()
    Dim Dosya As String, Baglanti As Object
    Dim Tum_Tablolar As Object, Sayfa As Object
   
    Set Baglanti = CreateObject("AdoDb.Connection")
    Set Tum_Tablolar = CreateObject("AdoX.Catalog")
    Set Sayfa = CreateObject("AdoX.Table")
   
    Dosya = "C:\Users\Desktop\İZİN PROGRAMI.xlsm"
   
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""
   
    Tum_Tablolar.ActiveConnection = Baglanti
   
    ListBox1.Clear
   
    For Each Sayfa In Tum_Tablolar.Tables
        If Replace(Sayfa.Name, "'", "") Like "*$" And InStr(1, Sayfa.Name, "Print_Area") = 0 Then
            ListBox1.AddItem Replace(Replace(Sayfa.Name, "'", ""), "$", "")
        End If
    Next

    Set Baglanti = Nothing
    Set Tum_Tablolar = Nothing
    Set Sayfa = Nothing
End Sub

 

[Feylosof]

Alternatif;

Option Explicit

Private Sub UserForm_Initialize()
    Dim Dosya As String, Baglanti As Object
    Dim Tum_Tablolar As Object, Sayfa As Object
  
    Set Baglanti = CreateObject("AdoDb.Connection")
    Set Tum_Tablolar = CreateObject("AdoX.Catalog")
    Set Sayfa = CreateObject("AdoX.Table")
  
    Dosya = "C:\Users\Desktop\İZİN PROGRAMI.xlsm"
  
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""
  
    Tum_Tablolar.ActiveConnection = Baglanti
  
    ListBox1.Clear
  
    For Each Sayfa In Tum_Tablolar.Tables
        If Replace(Sayfa.Name, "'", "") Like "*$" And InStr(1, Sayfa.Name, "Print_Area") = 0 Then
            ListBox1.AddItem Replace(Replace(Sayfa.Name, "'", ""), "$", "")
        End If
    Next

    Set Baglanti = Nothing
    Set Tum_Tablolar = Nothing
    Set Sayfa = Nothing
End Sub

Korhan Hocam çok teşekkür ederim. Emeğinize sağlık.