Çalışma kitabındaki toplam sayfa sayını öğrenme

[cengiz123]

Merhaba ustalarım,
Bir makro yazmak istiyorum. Excel çalışma kitabı içindeki toplam kaç tane çalışma sayfası var bulmak istiyorum.
Excel çalışma kitabını açıp toplam sayfa sayısını bulabiliyorum ama çalışma kitabını açmadan bir çalışma kitabının içinde kaç sayfa var bulunabilir mi?
Şimdiden teşekkürler

 

[Hakan ERDOST]

Bir çözüm önerisi..

Sub OpenClosedWorkbook()
    Dim xWb As Workbook
    Dim wbName As String
    On Error Resume Next
    Set xWb = Workbooks.Open("c:\..\...\..._.xls")
    wbName = xWb.Name
    If Err.Number <> 0 Then
        MsgBox "This workbook does not exist", vbInformation, "..."
        Err.Clear
    
    End If
    MsgBox "Sayfa sayısı: " & Application.Sheets.Count
    ActiveWorkbook.Close
End Sub

 

[cengiz123]

Merhaba
Cevabınız için teşekkür ederim.
Dediğiniz şekilde Excel açarak yapabiliyorum ama benim sormak istediğim, Exceli hiç açmadan sayfa sayısını öğrenebilirmiyiz?

 

[Erdem Akdemir]

Merhaba,

Aşağıdaki kodu kullanabilirsiniz.

Sub sdds()

Set cat = CreateObject("ADOX.Catalog")
Set con = VBA.CreateObject("adodb.Connection")

yol = dosya yolu

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
yol & ";extended properties=""Excel 12.0;hdr=yes"""

cat.ActiveConnection = con

MsgBox cat.tables.Count

End Sub

 

[cengiz123]

Erdem hocam çok teşekkür ederim. Tam aradığım kod.
Bir soru sormak istiyorum. Bir Excel dosyasında 5 sayfa var ancak kodla 7 olarak geliyor. Sıfır Excel dosyası oluşturuyorum. Mesela onda birebir doğru gösteriyor neden olabilir?

 

[Erdem Akdemir]

Erdem hocam çok teşekkür ederim. Tam aradığım kod.
Bir soru sormak istiyorum. Bir Excel dosyasında 5 sayfa var ancak kodla 7 olarak geliyor. Sıfır Excel dosyası oluşturuyorum. Mesela onda birebir doğru gösteriyor neden olabilir?

Gizli sayfalar vardır.

 

[Haluk]

Erdem hocam çok teşekkür ederim. Tam aradığım kod.
Bir soru sormak istiyorum. Bir Excel dosyasında 5 sayfa var ancak kodla 7 olarak geliyor. Sıfır Excel dosyası oluşturuyorum. Mesela onda birebir doğru gösteriyor neden olabilir?

Gizli sayfalar vardır.

Erdem Beyin kodunda; "gizli sayfaların" sonucu değiştirmemesi gerekir. Ancak; eğer dosyada önceden sayfalarda tanımlanmış alanlar varsa, onlar da "Table" olarak değerlendirildiği için, sayfa adedi gerçekte olduğundan daha fazla gibi gösteriliyor olabilir.



|_____|_____|____|____|____|____|____|____|____|
|_____|_____|____|____|____|____|____|____|____|
|_____|_____|____|____|____|____|____|____|____|
\__Sheet1__/\__Sheet2__/\__Sheet3__/


.

 

[cengiz123]

Gizli sayfalar değil hocam. Onu kontrol etmiştim. Neyse doğruya en yakın veriye en azından ulaşılmış oluyor
Teşekkür ederim destekleriniz için

 

[Haluk]

7. mesajda bahsettiğim gibi; dosyada tanımlanmış ad olup olmadığına baktınız mı?

.

 

[Erdem Akdemir]

Haluk bey,

Dediğiniz durumu denedim.Sayfa'da oluşturduğum tablolar ADO.CATALOG'da görünmedi.
VBA'dan veryhidden gizleseniz bile ADO.CATALOG'da tablo olarak görünüyor.

 

[Haluk]

Erdem Bey;

Bahsettiğim "Tablo" tanımı; ad tanımlamayla sayfada bazı alanların adlandırılmasıyla oluşan "Table" nesneleridir.

Ekli dosyada sizin kodu çalıştırdığımda sonuç "5" olarak dönüyor, sizde durum farklı mı?

.

 

[cengiz123]

Ad tanımlama yada tablo olup olmadığını nasıl anlayacağız?

 

[Haluk]

Excel'de "Formulas" sekmesinde "Name Manager" menüsünü çalıştırın.

.

 

[halit3]

Alternatif kod:
bu kod sayfaları A sutununa yazdırıyor.

Sub OpenWorkbook2()
Dim fd As FileDialog
Dim Dosya As String
Set fd = Application.FileDialog(msoFileDialogOpen)

Dim FileChosen As Integer
FileChosen = fd.Show
fd.Title = "İptal"
fd.InitialFileName = ThisWorkbook.Path

fd.ButtonName = "Aç"
If FileChosen <> -1 Then
MsgBox "İptal ettiniz."
Else
Dosya = fd.SelectedItems(1)

Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")
Uzanti = fL.GetExtensionName(Dosya)

Dim Katalog As Object, Data As Object, Tablo As Object
Dim son1
Set Data = CreateObject("ADODB.Connection")
Set Katalog = CreateObject("ADOX.Catalog")

If Uzanti = "xls" Then
Data.Open "Driver={Microsoft Excel Driver (*.xls)};Dbq=" & Dosya & ";"
GoTo atla1
End If

If Uzanti = "xlsx" Or Uzanti = "xlsm" Or Uzanti = "xlsb" Then
Data.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};Dbq=" & Dosya & ";"
GoTo atla1
End If

GoTo atla2

atla1:
say = 0
Katalog.ActiveConnection = Data

For Each Tablo In Katalog.Tables
If InStr(1, Tablo.Type, "TABLE") > 0 Then
If Right(Tablo.Name, 19) <> "kaynağından_sorgula" Then
If Right(Tablo.Name, 14) <> "Yazdırma_Alanı" Then
son1 = Replace(Tablo.Name, "'", "")
If Right(son1, 1) <> "_" Then
If Right(son1, 1) = "$" Then
say = say + 1
Cells(say, 1) = Left$(son1, Len(son1) - 1)

End If
End If
End If
End If
End If
Next

Set Data = Nothing
Set Katalog = Nothing


MsgBox say & " sayfa"
atla2:

End If
End Sub

 

[Erdem Akdemir]

@Haluk bey sonuç bende de 5 çıktı.

Kodu aşağıdaki gibi yaparsak kesin sayfa sayısını bulmuş oluruz. (Sizin eklediğiniz dosya'da 3)
Ad tanımlamada $ işareti kullanılamıyor.

Sub sdds()

Set cat = CreateObject("ADOX.Catalog")
Set con = VBA.CreateObject("adodb.Connection")

yol = dosya yolu

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
yol & ";extended properties=""Excel 12.0;hdr=yes"""

cat.ActiveConnection = con

For Each deg In cat.tables

If deg.Name Like "*" & "$" Then say = say + 1

Next deg

MsgBox say

End Sub

 

[Haluk]

@Haluk bey sonuç bende de 5 çıktı.

Kodu aşağıdaki gibi yaparsak kesin sayfa sayısını bulmuş oluruz. (Sizin eklediğiniz dosya'da 3)
Ad tanımlamada $ işareti kullanılamıyor.

Erdem Bey; dosyada "Print Area" set edilmişse, onu da "Table" olarak algılayabilir.

.

 

[Erdem Akdemir]

@Haluk bey Like "*" & "$" olduğu sürece printarea'dan etkilenmez.

 

[Haluk]

Ama "print area" tanımlandığında, sonu "$" ile bitiyor diye hatırlıyorum. O yüzden ikaz etmek istedim.

.

 

[Erdem Akdemir]

Siz sanırım bilgisayar başında değilsiniz. Bende excel 2013 Türkçe var. Cat nesnesinin altında tablo adı Sheet1$Print_Area olarak geliyor.

 

[Haluk]

Siz sanırım bilgisayar başında değilsiniz. Bende excel 2013 Türkçe var. Cat nesnesinin altında tablo adı Sheet1$Print_Area olarak geliyor.

Guzel haber bu, o zaman mesele yok.

.