Kapalı Excel dosyasında sayfa adı sorgulama

istikam · 14 Eylül 2008

Forumdaki herkese selamlar,

Konuyu araştırdım fakat forumda göremedim. Forumda varıysa affedin.

Kapalı bir excel dosyasından veri alıyorum fakat dosyadaki sayfaların isimlerini herzaman bilemiyorum. Kapalı olan dosyanın sayfalarının isimlerini bulabilir miyim?

Örnek: Ekteki hedef.xls dosyası C:\'de bulunuyor. ana.xls dosyasındaki buton ile hedef.xls içindeki sayfalardan veri alıyorum [ExecuteExcel4Macro(...)] ile.

Ancak benim bildirdiğim sayfa hedef.xls içinde yok ise #REF! hatası veriyor.

Yardımlarınız için çok teşekkür ederim.

Korhan Ayhan · 14 Eylül 2008

Selamlar,

Kullandığınız kodu aşağıdaki şekilde değiştirip denermisiniz.

Kod:

Private Sub CommandButton1_Click()
    ay = Range("E1")
    If Not IsError(ExecuteExcel4Macro("'C:\[hedef.xls]" & ay & "'!R1C1")) Then
    For i = 1 To 10
    Range("B" & i) = ExecuteExcel4Macro("'C:\[hedef.xls]" & ay & "'!R" & i & "C2")
    Next
    Else
    MsgBox "Aranan sayfa bulunamam&#305;&#351;t&#305;r !", vbCritical
    End If
End Sub

istikam · 14 Eylül 2008

Teşekkürler, kod işimi gördü.

İlginiz için teşekkür ederim. Örnek dosyada kodları düzelttim ve işe yaradı.
Bu arada kapalı dosyadaki sayfa adlarını listelemenin yolu var mı acaba.

Konu başlığını bu şekilde açmıştım. Hem ben hem de merak eden diğer arkadaşlar için faydalı olabilir.

Selamlar...

Korhan Ayhan · 14 Eylül 2008

Selamlar,

Sn. Zeki GÜRSOY beyin bir başka başlıkta yayınladığı aşağıdaki kodu kullanabilirsiniz.

C:\Kitap1.xls kısmını kendinize göre düzenlemeyi unutmayınız.

Kod:

Option Explicit
 
Sub KAPALI_DOSYADAK&#304;_SAYFA_&#304;S&#304;MLER&#304;()
    Dim Katalog As Object, Ba&#287;lant&#305; As Object, Sayfa As Object, Sat&#305;r As Integer
 
    Set Ba&#287;lant&#305; = CreateObject("ADODB.Connection")
    Set Katalog = CreateObject("ADOX.Catalog")
 
    Ba&#287;lant&#305;.Open _
    "Driver={Microsoft Excel Driver (*.xls)};Dbq=[COLOR=red][B]C:\Kitap1.xls[/B][/COLOR];"
    Katalog.ActiveConnection = Ba&#287;lant&#305;
 
    [A:A].ClearContents
 
    'If Sayfa.Type = "TABLE" Then alan isimlerini d&#246;nd&#252;r&#252;r.
 
    For Each Sayfa In Katalog.Tables
        If Sayfa.Type = "SYSTEM TABLE" Then
            Sat&#305;r = Sat&#305;r + 1
            Cells(Sat&#305;r, 1) = Left$(Sayfa.Name, Len(Sayfa.Name) - 1)
        End If
    Next
 
    Set Ba&#287;lant&#305; = Nothing
    Set Katalog = Nothing
    MsgBox "&#304;&#351;leminiz tamamlanm&#305;&#351;t&#305;r.", vbInformation
End Sub

Halit TÜRK · 14 Eylül 2008

Selam, kod çok güzel çalışıyor. Kapalı sayfada şifre varsa nasıl düzenlemek gerekiyor. Teşekkürler...

Not: Başka dosyada birkaç denemeden sonra farkettim, 89 sayfa olmasına rağmen 6 adet listeledi..

Zeki Gürsoy · 14 Eylül 2008

htrk' Alıntı:
Selam, kod çok güzel çalışıyor. Kapalı sayfada şifre varsa nasıl düzenlemek gerekiyor. Teşekkürler...

Not: Başka dosyada birkaç denemeden sonra farkettim, 89 sayfa olmasına rağmen 6 adet listeledi..

Selamlar,

Şifreli excel kapalı dosyasına ADO bağlantısı açılamıyor malesef. Dosyanız şifresiz olmalı.

89 sayfanın 6 sını listelemesi ters bir durum. Atladığınız bir durum olmalı.

Halit TÜRK · 15 Eylül 2008

Selamlar... Boş bir sayfa açıyorum 15 sayfa açıyorum. Diğer sayfadan 4. mesajdakii kod ile standart çalışıyor. Ama bir kaç dosyam bulunmakta ama bu dosyalarda eksik listeliyor. C:\ dizininde...

Not: Zeki bey zannederim sorun sayfa adında kullanılan boşluklardan kaynaklanıyor. "Sayfa1" ise sıralıyor, "Sayfa 1" ise almıyor. Boşluk olmayanları sıralıyor. Yeni açtığım 15 sayfada da aynı durumdadır.

Korhan Ayhan · 15 Eylül 2008

Selamlar,

Sn. htrk,

Aşağıdaki kodu kullanabilirsiniz. Fakat bu kodda eğer kapalı dosyanızda sayfalarda alanlara ad tanımlası yaptıysanız bunlarda listelenmektedir.

Benim aklıma gelen en uygun çözüm kapalı dosyayı açıp döngü ile sayfa isimlerini almaktır. İstenirse bu yönde çözüm üretebiliriz.

Kod:

Option Explicit
 
Sub KAPALI_DOSYADAK&#304;_SAYFA_&#304;S&#304;MLER&#304;()
    Dim Katalog As Object, Ba&#287;lant&#305; As Object, Sayfa As Object, Sat&#305;r As Integer
 
    Set Ba&#287;lant&#305; = CreateObject("ADODB.Connection")
    Set Katalog = CreateObject("ADOX.Catalog")
 
    Ba&#287;lant&#305;.Open _
    "Driver={Microsoft Excel Driver (*.xls)};Dbq=C:\Kitap1.xls;"
    Katalog.ActiveConnection = Ba&#287;lant&#305;
 
    [A:A].ClearContents
 
    For Each Sayfa In Katalog.Tables
        If Sayfa.Type = "TABLE" Or Sayfa.Type = "SYSTEM TABLE" Then
            Sat&#305;r = Sat&#305;r + 1
            Cells(Sat&#305;r, 1) = Replace(Replace(Sayfa.Name, "$", ""), "'", "")
        End If
    Next
 
    Set Ba&#287;lant&#305; = Nothing
    Set Katalog = Nothing
    MsgBox "&#304;&#351;leminiz tamamlanm&#305;&#351;t&#305;r.", vbInformation
End Sub

Korhan Ayhan · 15 Eylül 2008

Selamlar,

Aşağıdaki kod ile kapalı olan dosya açılarak sayfa isimleri alınmaktadır. Bu şekilde şifreli dosyalarda da işlem yapabilirsiniz.

Kod:

Option Explicit
 
Sub KAPALI_DOSYADAK&#304;_SAYFA_&#304;S&#304;MLER&#304;()
    Dim HEDEF_DOSYA As Workbook, Sayfa As Object, Sat&#305;r As Integer
 
    Application.ScreenUpdating = False
 
    Workbooks.Open Filename:="C:\Kitap1.xls", UpdateLinks:=3, Password:="12345", WriteResPassword:="12345"
    Set HEDEF_DOSYA = ActiveWorkbook
 
    ActiveWindow.Visible = False
 
    [A:A].ClearContents
 
    For Each Sayfa In HEDEF_DOSYA.Worksheets
        Sat&#305;r = Sat&#305;r + 1
        Cells(Sat&#305;r, 1) = Sayfa.Name
    Next
 
    HEDEF_DOSYA.Close 0
 
    Application.ScreenUpdating = True
 
    MsgBox "&#304;&#351;leminiz tamamlanm&#305;&#351;t&#305;r.", vbInformation
End Sub

Halit TÜRK · 15 Eylül 2008

Selamlar...

Sonuç veriyor fakat 15 civarı ad tanımlama bulunmaktadır. Acaba sayfa isimleriini birleştirmiş olsaydı, 3. sayfadan iyibaren yazdıkmak için nasıl olmalıdır.
Tabiki birleştirilmeden sonuç tercihimdir.

Halit TÜRK · 15 Eylül 2008

Selam, 9. mesajınız sonuç veriyor fakat dosyaya bağlı başka dosyada bulunmakta olduğu için update edilmek istiyor yani dosya açılıyor. Açık kullanmak söz konusu olunca dış veri özelliği ile alabiliyorum..

Not: Şifreli sayfalarda da çalışıyor, sadece update edilmemesi sorunu devam ediyor..

Korhan Ayhan · 15 Eylül 2008

Selamlar,

9. mesajımdaki koda güncelleme koduda eklenmiştir. İncelermisiniz.

Halit TÜRK · 15 Eylül 2008

Selamlar, ilginize çok çok teşekkürler..

Bu şekilde sorunsuz çalışıyor, kapalı sayfanın 3. sayfasından itibaren almak mümkünmüdür...

Korhan Ayhan · 15 Eylül 2008

Selamlar,

Aşağıdaki kodu denermisiniz.

Kod:

Option Explicit
 
Sub KAPALI_DOSYADAK&#304;_SAYFA_&#304;S&#304;MLER&#304;()
    Dim HEDEF_DOSYA As Workbook, Sayfa As Object, Sat&#305;r As Integer, X As Integer
 
    Application.ScreenUpdating = False
 
    Workbooks.Open Filename:="C:\Kitap1.xls", UpdateLinks:=3, Password:="12345", WriteResPassword:="12345"
    Set HEDEF_DOSYA = ActiveWorkbook
 
    ActiveWindow.Visible = False
 
    [A:A].ClearContents
 
    For X = 3 To HEDEF_DOSYA.Worksheets.Count
        Sat&#305;r = Sat&#305;r + 1
        Cells(Sat&#305;r, 1) = HEDEF_DOSYA.Sheets(X).Name
    Next
 
    HEDEF_DOSYA.Close 0
 
    Application.ScreenUpdating = True
 
    MsgBox "&#304;&#351;leminiz tamamlanm&#305;&#351;t&#305;r.", vbInformation
End Sub

Halit TÜRK · 15 Eylül 2008

Selamlar,

Zeki beyin kodu ile de aynı sonuca ulaştım ama 3. sayfadan itibaren sayfa isimlerini almak için nasıl düzeltme gerekir. (Şifresiz)

Kod:

Sub KAPALI_DOSYADAK&#304;_SAYFA_&#304;S&#304;MLER&#304;1()
    Dim Katalog As Object, Ba&#287;lant&#305; As Object, Sayfa As Object, Sat&#305;r As Integer
 
    Set Ba&#287;lant&#305; = CreateObject("ADODB.Connection")
    Set Katalog = CreateObject("ADOX.Catalog")
 
    Ba&#287;lant&#305;.Open _
    "Driver={Microsoft Excel Driver (*.xls)};Dbq=C:\Kitap1.xls;"
    Katalog.ActiveConnection = Ba&#287;lant&#305;
 
    [I:I].ClearContents
 
    For Each Sayfa In Katalog.Tables
        If Sayfa.Type = "TABLE" Then
            Sat&#305;r = Sat&#305;r + 1
            Cells(Sat&#305;r, 9) = Left$(Sayfa.Name, Len(Sayfa.Name) - 2)
        End If
    Next
 
    Set Ba&#287;lant&#305; = Nothing
    Set Katalog = Nothing
    MsgBox "&#304;&#351;leminiz tamamlanm&#305;&#351;t&#305;r.", vbInformation
End Sub

Korhan Ayhan · 10 Ekim 2008

Selamlar,

Aşağıdaki kodu denermisiniz.

Kod:

Option Explicit
 
Sub KAPALI_DOSYADAK&#304;_SAYFA_&#304;S&#304;MLER&#304;1()
    Dim Katalog As Object, Ba&#287;lant&#305; As Object, Sayfa As Object, Sat&#305;r As Integer, Say As Integer
 
    Set Ba&#287;lant&#305; = CreateObject("ADODB.Connection")
    Set Katalog = CreateObject("ADOX.Catalog")
 
    Ba&#287;lant&#305;.Open _
    "Driver={Microsoft Excel Driver (*.xls)};Dbq=C:\Kitap1.xls;"
    Katalog.ActiveConnection = Ba&#287;lant&#305;
 
    [I:I].ClearContents
 
    For Each Sayfa In Katalog.Tables
        If Sayfa.Type = "TABLE" Then
            Say = Say + 1
            If Say >= 3 Then
            Sat&#305;r = Sat&#305;r + 1
            Cells(Sat&#305;r, 9) = Left$(Sayfa.Name, Len(Sayfa.Name) - 2)
            End If
        End If
    Next
 
    Set Ba&#287;lant&#305; = Nothing
    Set Katalog = Nothing
    MsgBox "&#304;&#351;leminiz tamamlanm&#305;&#351;t&#305;r.", vbInformation
End Sub

baydeniro · 7 Temmuz 2012

Paylaşım için teşekkürler.

Murat OSMA · 7 Temmuz 2012

Dosyadaki sayfa isimlerini UserFom'daki ListBox'ta listelemek için şu kodları kullanabilirsiniz;

Kod:

Private Sub UserForm_Initialize()
    Dim con As Object, kat As Object, tbl As Object
    Dim dosya As String
    
    Set con = CreateObject("adodb.connection")
    Set kat = CreateObject("adox.catalog")
    Set tbl = CreateObject("adox.table")
    
    dosya = ThisWorkbook.FullName
    con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dosya & _
    ";Extended Properties=""Excel 8.0"""
    
    kat.ActiveConnection = con
    For Each tbl In kat.Tables
        ListBox1.AddItem Left(tbl.Name, Len(tbl.Name) - 1)
    Next tbl
End Sub

Private Sub UserForm_Terminate()
    Set tbl = Nothing: Set kat = Nothing: Set con = Nothing
    dosya = vbNullString
End Sub

Kapalı Excel dosyasında sayfa adı sorgulama

istikam

Korhan Ayhan

Administrator

istikam

Korhan Ayhan

Administrator

Halit TÜRK

Zeki Gürsoy

Uzman

Halit TÜRK

Korhan Ayhan

Administrator

Korhan Ayhan

Administrator

Halit TÜRK

Halit TÜRK

Korhan Ayhan

Administrator

Halit TÜRK

Korhan Ayhan

Administrator

Halit TÜRK

Korhan Ayhan

Administrator

baydeniro

Murat OSMA

Altın Üye