Filtreleyip çıktı alma

[samedgunduz]

Örnek dosyada her ay şoförlere ödenen harcırah rakamları yer almaktadır.
130 a yakın şoför mevcut.
Tüm isimleri tek tek filtreleyip çıktı sayfası sekmesindeki gibi basit bir çıktı alıyoruz.
Bunu tek tuş ile yapabileceğimiz herhangi bir makro veya buton yapabilir miyiz?
Yani liste her hafta güncelleniyor örnek bir şablon olsa her hafta listeyi bu şablona yapıştırsak tek buton ile personeli ayrı sayfalarda kendi ayırıp çıktıya hazır hale getirse işimiz çok kolaylaşacak. Bize gerekli olan şey o ay şoföre verilen harcırah toplamı. (Örnek Şablon çıktı sayfası) Deneyimli hocalarımızdan ve arkadaşlarımızdan destek bekliyorum.

Şimdiden elinize sağlık.

 

[Korhan Ayhan]

Deneyiniz.

"Sayfa1" yazdırma alanını ayarlamayı unutmayın. Ben tek sayfaya sığdır diyerek deneme yaptım.

Option Explicit

Sub Filtrele_Yazdir()
    Dim S1 As Worksheet, S2 As Worksheet, Dizi As Object, Aranan As String
    Dim Kriter As Variant, Veri As Variant, Son As Long, X As Long, Onay As Byte
   
    Onay = MsgBox("Toplu yazdırma işlemi yapılacaktır." & vbLf & vbLf & _
                  "İşlemi onaylıyor musunuz?", vbCritical + vbYesNo + vbDefaultButton2)
   
    If Onay = vbNo Then
        MsgBox "Yazdırma işlemi iptal edilmiştir!", vbExclamation
        Exit Sub
    End If
   
    Application.ScreenUpdating = 0
   
    Set S1 = Sheets("31535494_20201229_HesapÖzeti")
    Set S2 = Sheets("Sayfa1")
    Set Dizi = CreateObject("Scripting.Dictionary")
   
    On Error Resume Next
    S1.ShowAllData
    On Error GoTo 0
   
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
   
    If Son <= 2 Then Son = 3
   
    Veri = S1.Range("C2:C" & Son).Value
   
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If InStr(1, Veri(X, 1), " *TR") > 0 Then
            Aranan = Split(Veri(X, 1), " *TR")(0)
            Dizi.Item(Aranan) = 1
        End If
    Next

    For Each Kriter In Dizi.Keys
        S1.Range("A1:C" & S1.Rows.Count).AutoFilter 3, Kriter & "*"
        Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
        If Son >= 2 Then
            S2.Range("A:C").Clear
            S1.Range("A1:C" & Son).Copy S2.Range("A1")
            S2.Columns.AutoFit
            S2.PrintOut , , 1
        End If
    Next

    On Error Resume Next
    S1.ShowAllData
    On Error GoTo 0

    Set S1 = Nothing
    Set S2 = Nothing
    Set Dizi = Nothing
   
    Application.ScreenUpdating = 1

    MsgBox "Tüm liste yazdırılmıştır."
End Sub

 

[samedgunduz]

Korhan Hocam çok teşekkür ediyorum gerçekten bu işin pirisiniz.

Direkt yazdırmadan önce ön izleme yapma şansımız varmı hocam kontrol etmek amaçlı.

 

[Korhan Ayhan]

Kod içindeki aşağıdaki satırı bir sonraki gibi değiştirip deneyiniz.

Eski hali; S2.PrintOut , , 1

Yeni hali; S2.PrintOut , , 1, True

 

[samedgunduz]

Kod içindeki aşağıdaki satırı bir sonraki gibi değiştirip deneyiniz.

Eski hali; S2.PrintOut , , 1

Yeni hali; S2.PrintOut , , 1, True

Hocam oldu fakat ön izlemede tüm sayfaları göremiyorum (yani sayfalar arası geçiş yapamıyorum) ve yazdırmadan çıkmak için hepsini tek tek onaylamadan çıkmıyor
@Korhan Ayhan

 

[Korhan Ayhan]

Amacımız zaten tüm sayfaları topluca yazdırmaktı.

Tek tek isimlere göre filtreleme yaptığı için ve sonrasında yazdırdığı için bu sorunu yaşarsınız.

 

[Korhan Ayhan]

Eğer yazdırmak istemediğiniz isimler belli ise kod içinde eleyebiliriz.

Ya da verileri ayrı sayfalara aktarıp tek seferde önizleme yaptırabiliriz. Sonrasında siz kontrol ederek yazdırabilirsiniz. Bu yöntem yavaş çalışmaktadır. Ben denediğimde verileri sayfalara aktarıp önizleme yapması 5 dakika sürdü. Belki sizde daha hızlı çalışır.

 

[samedgunduz]

Eğer yazdırmak istemediğiniz isimler belli ise kod içinde eleyebiliriz.

Ya da verileri ayrı sayfalara aktarıp tek seferde önizleme yaptırabiliriz. Sonrasında siz kontrol ederek yazdırabilirsiniz. Bu yöntem yavaş çalışmaktadır. Ben denediğimde verileri sayfalara aktarıp önizleme yapması 5 dakika sürdü. Belki sizde daha hızlı çalışır.

Bende 30 sn gibi bir sürede açılıyor hocam tam olarak anlatmak istediğim buydu süpersiniz elinize sağlık. Şimdi de ön izleme sayfasında bir sorun oluşuyor hocam. Filtrele butonunu tıkladığımda işlem bitince ön izleme sayfasına giriyor ama sadece en sondaki sayfanın görüntüsü geliyor sonraki sayfayı tıkladım, page up down tuşlarına bastım, sağdan ekranı aşağı kaydırdım, farenin yuvarlak düğmesini döndürdüm yani her yolu denedim diğer sayfalara geçmiyor çubuk aşağı yukarı hareket ediyor ama aynı sayfada kalıyor. @Korhan Ayhan

 

[Korhan Ayhan]

Açılan pencerede aşağı-yukarı ok tuşları ile gezinebilirsiniz.

 

[samedgunduz]

Açılan pencerede aşağı-yukarı ok tuşları ile gezinebilirsiniz.

Geçmiyor hocam aşağı yukarı bastığımda sağdaki ok hareket ediyor ama sayfa aynı kalıyor. şunu farkettim ok tuşuna basıyorum değişmiyor sayfayı simge durumuna küçült yaptığımda ve tekrar geri açtığımda ancak sayfa değişmiş oluyor @Korhan Ayhan

 

[Korhan Ayhan]

Eğer sayfayı görmek için büyültürseniz (yakınlaştır) aşağı-yukarı ok tuşları çalışmaz.