• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

  • Konbuyu başlatan Konbuyu başlatan smt
  • Başlangıç tarihi Başlangıç tarihi
S

smt

Katılım
19 Mayıs 2019
Mesajlar
17
Excel Vers. ve Dili
2016 tr
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
 
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
 
  • Beğen
Reactions: smt
Konuyla ilgili örnek bir dosya paylaşmanız mümkün mü?
 
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
Genişletmek için tıkla ...
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.
 
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.
Genişletmek için tıkla ...
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?
 
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?
Genişletmek için tıkla ...
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
 
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
 
  • Beğen
Reactions: smt
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
Genişletmek için tıkla ...
Hocam çok teşekkür ederim elinize sağlık
 
ActiveSheet.PrintOut , preview:=True

satırını böyle değiştirin.
ActiveSheet.PrintOut
 
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
Genişletmek için tıkla ...
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ı
 
Alt toplamı hangi sütunda veya sütünlarda aldırıyordunuz?
 
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
 
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
Genişletmek için tıkla ...
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.
 
Harici paylaşım sitesine örnek dosya yükleyebilir misiniz?
 
necati' Alıntı:
Harici paylaşım sitesine örnek dosya yükleyebilir misiniz?
Genişletmek için tıkla ...

İ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
 
Son düzenleme:
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
 
  • Beğen
Reactions: smt
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
Genişletmek için tıkla ...
Necati bey çok tesekkür ederim şuan ofis dışındayım deneyip dönüş yapacağım
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst