excel dosyasında sayfa sonunu makro ile belirleyerek otomatik alt çizgi ile kapatmak

[frankestein]

http://dosya.co/32guhzck074i/kasa_tahsilatı.xlsx.html

Adresteki dosyada görüleceği üzere 18 şubattaki giriş 50. satır olup sayfa sonuna denk geldiği için 50. satırı sayfa sonu olduğunu belirleyip makro ile alt çizgisini koyup ilgili sayfadaki kasa tahsilatını en altta toplam olarak göstermesini istiyorum. Bir sonraki sayfaya geçtiğinde ise genel başlığı tekrar başlatarak 51. satırdaki veriyi ikinci sayfanın başındaki veri olarak gösterip bir önceki işlemlerin tekrarlamasını istiyorum. Lütfen yardımcı olun...

 

[Asri]

Aşağıda kodu deneyiniz.

Sub menu()
  Call yazici_ayarla
  Call sayfasonu
End Sub

Sub yazici_ayarla()
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
        .RightMargin = Application.InchesToPoints(0.708661417322835)
        .TopMargin = Application.InchesToPoints(0.393700787401575)
        .BottomMargin = Application.InchesToPoints(0.393700787401575)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintSheetEnd
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
End Sub



Sub sayfasonu()
   ActiveWindow.View = xlPageBreakPreview
   ActiveSheet.DisplayAutomaticPageBreaks = False

   ActiveSheet.ResetAllPageBreaks
   For i = 1 To 100000
      If Cells(i, 2) = "" Then Exit For
      If i Mod 51 = 0 Then
        Rows(i).Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Cells(i, 2).Select
        ActiveCell.FormulaR1C1 = "=SUM(R[-49]C:R[-1]C)"

        Rows(i + 1).Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Cells(i + 1, 1).Select
        ActiveCell.FormulaR1C1 = "Tarih"
        Cells(i + 1, 2).Select
        ActiveCell.FormulaR1C1 = "Kasa Tahsilatı"
        Cells(i + 1, 3).Select
        ActiveCell.FormulaR1C1 = "Onay Kişi"
        Cells(i + 1, 4).Select
        ActiveCell.FormulaR1C1 = "Onay Tarihi"
        Columns("D:D").EntireColumn.AutoFit
        Columns("C:C").EntireColumn.AutoFit
        Columns("B:B").EntireColumn.AutoFit
        Columns("A:A").ColumnWidth = 13.29
    
        Rows(i).Select
        Selection.Copy
        Rows(i + 2).Select
        usttoplam = i + 2
        Selection.Insert Shift:=xlDown
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
           :=False, Transpose:=False
        Application.CutCopyMode = False
        Cells(i + 1, 1).Select
        ActiveWindow.SelectedSheets.HPageBreaks.Add before:=ActiveCell
      End If
    Next i
    
    If Cells(i - 1, 1) <> "" And Cells(i - 1, 1) <> "Tarih" Then
       Cells(i, 2).Select
       aralik = i - usttoplam
       ActiveCell.FormulaR1C1 = "=SUM(R[-" & aralik & "]C:R[-1]C)"
    End If

End Sub

 

[frankestein]

Eline sağlık çok güzel olmuş, sayfasonu alttaki bitiş çizgisini koymuyor. Veriyi 1 sayfaya düşürdüğünde hesaplamayı sıfır gösteriyor. Yani toplamıyor. Sayfa toplamı ve genel toplam diye iki ayrı toplam göstermesi mümkün mü? Makro çalıştıktan sonra tekrar eski görüntüsüne gelmesini istiyorum çünkü alt toplamları sadece çıktı alırken lazım oluyor. Yazdırma alanında sayfaları yatay ve dikey tercihli nasıl yapabiliriz? Makroyu ikiye çıkarıp yatay istiyorsak yatay, dikey istiyorsak dikey düğmelerini ayrı ayrı mı tanımlamamız gerekir? Şimdiden teşekkürler...

 

[Asri]

Yatay ve dikey hariç diğer işlemleri aşağıdaki makro yapmaktadır.
Kontrol ediniz.

http://s2.dosya.tc/server2/jlsopu/Kasa_Tahsilati.zip.html

 

[frankestein]

Allah razı olsun, üstad çok güzel olmuş..