değişken veri sayısına göre sayfaları yazdırma

[dayi10]

Merhabalar,

Bir konuda yardımınıza ihtiyacım var. 2 tane sorum var. Sorularım aşağıdadır. örnek dosya ise ektedir. Şimdiden yardımlarınız için teşekkür ederim.



SORU 1
Yandaki bilgilerde 1. sayı ile 2. sayılara göre sayfa aralıkları vardır. Örnek olarak 1 ile 7 arası verilerin bulunduğu sayfa 1. sayfadır. Örneğin 421 ile 440 arası verilerin bulunduğu sayfa 24. sayfadır. Yapmak istediğim şudur. Arasayfa sayfamda 1 den 500'e kadar veri bulunabiliyor. Burada bulunan veri sayısına göre verinin hangi sayfada olduğunu buldurup o sayfa ondan önceki sayfaları topluca yazdırmak istiyorum.

Yani;
Öncelikle Arasayfa verilerin kaç tane olduğunu buldurmak istiyorum.

2. olarak verilerin kaç tane olduğunu buldurduktan sonra Arasayfa 343 tane veri var. Bu veri toplamının hangi sayfa olduğunu buldurmak istiyorum. Bunlarda yan taraftaki tablo aralıklar mevcuttur. 343 tane veri 19. sayfada bulunuyor.

Buna göre 1. ve 19. sayfalarda dahil olmak üzere bu sayfaları yazdır butonuna bastığımda çıktısını almak istiyorum.



SORU 2

Birde 1 ile 26 sayfaları aralığından her sayfanını A hücresine Arasayfa daki verilere toplam kaç sayfa olduğunu yazdırmak istiyorum. örnek olarak Arasayfada bulunan 343 veri sayısına göre 19. sayfadaki veriler aralığında olduğu için her sayfanın yani 1 ile 26 sayfa aralığındaki sayfaların A1 hücresine toplam sayfa sayısı olarak 19 yazdırmak istiyorum.

 

[Korhan Ayhan]

Ekteki örnek dosyayı inceleyiniz.

 

[dayi10]

Ekteki örnek dosyayı inceleyiniz.

teşekkür ederim korhan bey açıklama sayfasındaki bilgilere göre değilde kod üzerinden bu işlemleri yapabilirmiyiz. açıklama sayfasındaki veriler üzerinden değilde kod ortamında yapabilirsek çok daha iyi olacak.

açıklama sayfasında g1 hücresindeki 1 i ilk sayfa olarakmı düşündünüz

 

[Korhan Ayhan]

Örnek dosyaya aşağıdaki kodu uygulayıp deneyiniz.

Sub YAZDIR()
    Dim S1 As Worksheet, X As Integer
    Dim Kucuk As Integer, Buyuk As Integer
    Dim Veri_1 As String, Veri_2 As String
    
    Set S1 = Sheets("Arasayfa")
    
    Kucuk = WorksheetFunction.Min(S1.Range("D:D"))
    Buyuk = WorksheetFunction.Max(S1.Range("D:D"))
    
    For X = ThisWorkbook.Worksheets.Count To 1 Step -1
        If IsNumeric(Sheets(X).Name) Then
            Set Bul = Sheets(X).Range("D:D").Find(Kucuk, , , xlWhole)
            If Not Bul Is Nothing Then
                Veri_1 = Sheets(X).Name
            End If
            If Veri_2 = "" Then
                Set Bul = Sheets(X).Range("D:D").Find(Buyuk, , , xlWhole)
                If Not Bul Is Nothing Then
                    Veri_2 = Sheets(X).Name
                End If
            End If
        End If
    Next
    
    If Veri_1 <> "" And Veri_2 <> "" Then
        For X = Val(Veri_1) To Val(Veri_2)
            Sheets(CStr(X)).PrintOut
        Next
        
        MsgBox "Yazdırma işlemi tamamlanmıştır.", vbInformation
    Else
        MsgBox "Yazdırılacak sayfa bulunamadı!", vbExclamation
    End If
End Sub

 

[dayi10]

Örnek dosyaya aşağıdaki kodu uygulayıp deneyiniz.

Sub YAZDIR()
    Dim S1 As Worksheet, X As Integer
    Dim Kucuk As Integer, Buyuk As Integer
    Dim Veri_1 As String, Veri_2 As String
    
    Set S1 = Sheets("Arasayfa")
    
    Kucuk = WorksheetFunction.Min(S1.Range("D:D"))
    Buyuk = WorksheetFunction.Max(S1.Range("D:D"))
    
    For X = ThisWorkbook.Worksheets.Count To 1 Step -1
        If IsNumeric(Sheets(X).Name) Then
            Set Bul = Sheets(X).Range("D:D").Find(Kucuk, , , xlWhole)
            If Not Bul Is Nothing Then
                Veri_1 = Sheets(X).Name
            End If
            If Veri_2 = "" Then
                Set Bul = Sheets(X).Range("D:D").Find(Buyuk, , , xlWhole)
                If Not Bul Is Nothing Then
                    Veri_2 = Sheets(X).Name
                End If
            End If
        End If
    Next
    
    If Veri_1 <> "" And Veri_2 <> "" Then
        For X = Val(Veri_1) To Val(Veri_2)
            Sheets(CStr(X)).PrintOut
        Next
        
        MsgBox "Yazdırma işlemi tamamlanmıştır.", vbInformation
    Else
        MsgBox "Yazdırılacak sayfa bulunamadı!", vbExclamation
    End If
End Sub

Yazdırılacak sayfa bulunamadı diye hata veriyor ama neden olabilirki acaba

 

[Korhan Ayhan]

Veri_2 isimli değişken boş olursa o uyarıyı alırsınız...

Kodun çalışma mantığı;

"Arasayfa" da en küçük ve en büyük değeri buluyor.
Daha sonra sayfaları döngüye alıp bu değerleri sayfalarda arıyor.
Hangi sayfada bulursa o sayfanın index numarasını hafızaya alıyor.
Son aşamada hafızaya aldığı sayfa aralığını tekrar döngü ile yazdırıyor.

Yazdırma işlemi için Veri_1 ve Veri_2 değişkenlerine sayısal değer yüklenmiş olması gerekiyor.

 

[esurmeli]

Ekteki excelde Tutanak sayfasında tutanak numarası değiştiği zaman başka sayfaya geçiyormuş gibi veriler değişecek şekilde tasarladım. Binlerce sayfadan kurtuldum böylece. Fakat yazdırma sorunum var. İstediğim aralıktaki sayfaları yazdırmak istiyorum. Örneğin 10 ile 25 sayfalarını yazdırmak istediğimde tutanak numarasına bunları girip yazdıracak bir makro yapmaya çalıştım ama olmadı. Yardımcı olabilir misiniz?

 

[medishared]

Ekteki excelde Tutanak sayfasında tutanak numarası değiştiği zaman başka sayfaya geçiyormuş gibi veriler değişecek şekilde tasarladım. Binlerce sayfadan kurtuldum böylece. Fakat yazdırma sorunum var. İstediğim aralıktaki sayfaları yazdırmak istiyorum. Örneğin 10 ile 25 sayfalarını yazdırmak istediğimde tutanak numarasına bunları girip yazdıracak bir makro yapmaya çalıştım ama olmadı. Yardımcı olabilir misiniz?

merhaba çözümünü buldunuz mu?