Soru SATIRLARI BAŞLIĞIYA BERABER AYRI AYRI OTOMATİK YAZDIRMA

smt · 7 Nisan 2023

Merhaba,

Excel tablomda her satırı başlıklarıyla beraber ayrı ayrı otomatik olarak çıktı alabilirmiyim.Satır ve sütün sayısı değişebilir seçime bağlı olursa güzel olur

Greenblacksea53 · 7 Nisan 2023

C++:

Sub Tabloyazdir()
    Dim satir As Long
    Dim sutun As Long
    Dim yazdirRange As Range
    
    
    satir = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    sutun = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    
    
    Set yazdirRange = Range(Cells(1, 1), Cells(satir, sutun))
    

    ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"
    ActiveSheet.PageSetup.FitToPagesWide = 1
    ActiveSheet.PageSetup.FitToPagesTall = False
    
    yazdirRange.PrintOut
End Sub

Mödüle ekleyip tablonuzu yazdırabilirsiniz

Korhan Ayhan · 8 Nisan 2023

Konuyla ilgili örnek bir dosya paylaşmanız mümkün mü?

smt · 8 Nisan 2023

Greenblacksea53' Alıntı:

C++:

Sub Tabloyazdir()
    Dim satir As Long
    Dim sutun As Long
    Dim yazdirRange As Range
    
    
    satir = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    sutun = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    
    
    Set yazdirRange = Range(Cells(1, 1), Cells(satir, sutun))
    

    ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"
    ActiveSheet.PageSetup.FitToPagesWide = 1
    ActiveSheet.PageSetup.FitToPagesTall = False
    
    yazdirRange.PrintOut
End Sub

Mödüle ekleyip tablonuzu yazdırabilirsiniz

Hocam bu hepsini tek seferde yazdırıyor.Basit bir örnek vermek gerekirse filtrelenmiş bir tablom var ad soyad ve numara 1 den 100 kadar numara veriyorum ve listede 1000 kişi var filtredim numaraya göre tek tek ayrı sayfalarda çıktı alıyorum.Bunu otomatik olarak nasıl yaparım.

necati · 8 Nisan 2023

smt' Alıntı:
Hocam bu hepsini tek seferde yazdırıyor.Basit bir örnek vermek gerekirse filtrelenmiş bir tablom var ad soyad ve numara 1 den 100 kadar numara veriyorum ve listede 1000 kişi var filtredim numaraya göre tek tek ayrı sayfalarda çıktı alıyorum.Bunu otomatik olarak nasıl yaparım.

Merhaba,
Tabloda her satırı dediniz. Bu satır sayısı sabit mi. Yani her bir sayfada bir satır ve başlık mı yazdırıyorsunuz? Bazı sayfalardaki satırlar birden fazla olabilir mi?

smt · 8 Nisan 2023

necati' Alıntı:
Merhaba,
Tabloda her satırı dediniz. Bu satır sayısı sabit mi. Yani her bir sayfada bir satır ve başlık mı yazdırıyorsunuz? Bazı sayfalardaki satırlar birden fazla olabilir mi?

Yanlış ifade etmişim başlıklar tablolara göre değisebiliyor birden fazla genelde 4 veya 5 başlık ve filtreye göre satır sayısı birden fazla olabiliyor

necati · 8 Nisan 2023

A sütünundaki değişmeye göre yazdırmak. Başlık 1.satır olarak alındı.

Kod:

Sub Filtrele_Satir_Satir_Yaz()
Dim sonsat As Long
Dim sat As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set ws = ThisWorkbook.Worksheets("Sayfa1")
sonsat = Cells(Rows.Count, "A").End(3).Row

With ActiveSheet
    .ResetAllPageBreaks

    For i = 2 To sonsat
    Set rng = Range("A" & i)
        If rng.Value <> rng.Offset(1, 0).Value Then
            ActiveSheet.HPageBreaks.Add Before:=rng.Offset(1, 0)
        End If
    Next

End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True

ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"
ActiveSheet.PrintOut , preview:=True

ActiveSheet.ResetAllPageBreaks

End Sub

smt · 8 Nisan 2023

necati' Alıntı:

A sütünundaki değişmeye göre yazdırmak. Başlık 1.satır olarak alındı.

Kod:

Sub Filtrele_Satir_Satir_Yaz()
Dim sonsat As Long
Dim sat As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set ws = ThisWorkbook.Worksheets("Sayfa1")
sonsat = Cells(Rows.Count, "A").End(3).Row

With ActiveSheet
    .ResetAllPageBreaks

    For i = 2 To sonsat
    Set rng = Range("A" & i)
        If rng.Value <> rng.Offset(1, 0).Value Then
            ActiveSheet.HPageBreaks.Add Before:=rng.Offset(1, 0)
        End If
    Next

End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True

ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"
ActiveSheet.PrintOut , preview:=True

ActiveSheet.ResetAllPageBreaks

End Sub

Hocam çok teşekkür ederim elinize sağlık

necati · 8 Nisan 2023

ActiveSheet.PrintOut , preview:=True

satırını böyle değiştirin.
ActiveSheet.PrintOut

smt · 8 Nisan 2023

necati' Alıntı:
ActiveSheet.PrintOut , preview:=True

satırını böyle değiştirin.
ActiveSheet.PrintOut

Çok teşekkür ederim Necati bey emeğinize saglık.

necati · 8 Nisan 2023

Rica ederim, kolay gelsin.

smt · 10 Nisan 2023

necati' Alıntı:

A sütünundaki değişmeye göre yazdırmak. Başlık 1.satır olarak alındı.

Kod:

Sub Filtrele_Satir_Satir_Yaz()
Dim sonsat As Long
Dim sat As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set ws = ThisWorkbook.Worksheets("Sayfa1")
sonsat = Cells(Rows.Count, "A").End(3).Row

With ActiveSheet
    .ResetAllPageBreaks

    For i = 2 To sonsat
    Set rng = Range("A" & i)
        If rng.Value <> rng.Offset(1, 0).Value Then
            ActiveSheet.HPageBreaks.Add Before:=rng.Offset(1, 0)
        End If
    Next

End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True

ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"
ActiveSheet.PrintOut , preview:=True

ActiveSheet.ResetAllPageBreaks

End Sub

Necati bey merhaba,ilk filtrede bazı sütünlardaki rakamları alt toplam alıyorum tek tek döküm alırken her filtrede bu toplam görünüyordu ancak sizin kodda bu toplam gözükmüyor.Ekleme şansımız var mı rahatsız ettim kusura bakmayı

necati · 10 Nisan 2023

Alt toplamı hangi sütunda veya sütünlarda aldırıyordunuz?

smt · 10 Nisan 2023

necati' Alıntı:
Alt toplamı hangi sütunda veya sütünlarda aldırıyordunuz?

E ve F sütununda alt toplam yapıyorum

necati · 10 Nisan 2023

Kod:

Sub Alttoplamile_Satir_Satir_Yaz()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Range("A1").Select
Selection.RemoveSubtotal

Range("A1").Select
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(5, 6), _
    Replace:=False, PageBreaks:=True, SummaryBelowData:=True

Application.DisplayAlerts = True
Application.ScreenUpdating = True

ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"
ActiveSheet.PrintOut , preview:=True

ActiveSheet.ResetAllPageBreaks

Selection.RemoveSubtotal

End Sub

smt · 10 Nisan 2023

necati' Alıntı:

Kod:

Sub Alttoplamile_Satir_Satir_Yaz()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Range("A1").Select
Selection.RemoveSubtotal

Range("A1").Select
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(5, 6), _
    Replace:=False, PageBreaks:=True, SummaryBelowData:=True

Application.DisplayAlerts = True
Application.ScreenUpdating = True

ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"
ActiveSheet.PrintOut , preview:=True

ActiveSheet.ResetAllPageBreaks

Selection.RemoveSubtotal

End Sub

Bu kod çalışmadı Necati bey aslında yanlış ifade ettm E ve F sütununda alt toplam ifadesi yanliş oldu, normal toplam yapıyorum bir alt satırda toplam görünüyor filtre değiştikçe veriye göre değişiyor ancak ilk kodda yazdırırken görünmüyor.

necati · 10 Nisan 2023

Harici paylaşım sitesine örnek dosya yükleyebilir misiniz?

smt · 10 Nisan 2023

necati' Alıntı:
Harici paylaşım sitesine örnek dosya yükleyebilir misiniz?

İndir örnek tablo

Dosyayı indir örnek tablo

dosya.co

G sütunundaki her bir filtreye göre sırayla tek tek otomatik döküm(print) almak istiyorum E ve F de toplam yaptım her sayfada toplamda gözükmesi gerekiyor ilk yazdığınız kod işimi görüyor ancak toplamlar gözükse tam işimi görecek

necati · 10 Nisan 2023

Kod:

Sub Alttoplamile_Satir_Satir_Yaz2()
Dim sonsat As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

With ThisWorkbook.Worksheets("Sayfa1")
If .FilterMode Then .ShowAllData
End With

Range("A1").Select

Selection.RemoveSubtotal

Range("A1").Select
Selection.Subtotal GroupBy:=7, Function:=xlSum, TotalList:=Array(5, 6), _
    Replace:=False, PageBreaks:=True, SummaryBelowData:=True

Columns("E:F").SpecialCells(xlFormulas).Font.Bold = True

sonsat = Cells(Rows.Count, "G").End(3).Row

Range("G1:G" & sonsat).Select
    Selection.Replace What:="*Toplam*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
Application.DisplayAlerts = True
Application.ScreenUpdating = True

ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"
ActiveSheet.PrintOut , preview:=True

ActiveSheet.ResetAllPageBreaks

Selection.RemoveSubtotal

End Sub

smt · 10 Nisan 2023

necati' Alıntı:

Kod:

Sub Alttoplamile_Satir_Satir_Yaz2()
Dim sonsat As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

With ThisWorkbook.Worksheets("Sayfa1")
If .FilterMode Then .ShowAllData
End With

Range("A1").Select

Selection.RemoveSubtotal

Range("A1").Select
Selection.Subtotal GroupBy:=7, Function:=xlSum, TotalList:=Array(5, 6), _
    Replace:=False, PageBreaks:=True, SummaryBelowData:=True

Columns("E:F").SpecialCells(xlFormulas).Font.Bold = True

sonsat = Cells(Rows.Count, "G").End(3).Row

Range("G1:G" & sonsat).Select
    Selection.Replace What:="*Toplam*", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
Application.DisplayAlerts = True
Application.ScreenUpdating = True

ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"
ActiveSheet.PrintOut , preview:=True

ActiveSheet.ResetAllPageBreaks

Selection.RemoveSubtotal

End Sub

Necati bey çok tesekkür ederim şuan ofis dışındayım deneyip dönüş yapacağım

Soru SATIRLARI BAŞLIĞIYA BERABER AYRI AYRI OTOMATİK YAZDIRMA

Administrator