Yevmiye Defteri Yardım

[yinan]

arkadaşlar selam,

eminim birçoğunuz için basit bir soru olacak;

700 sayfalık bir yevmiye defteri datası var, ben bu datanın her sayfa sonuna borç ve alacak kısımları için ayrı ayrı diptoplam aldırıp sonraki sayfanında başında devreden tutar olarak çıkmasını istiyorum.

konuyla ilgili fikri olan var mı acaba?

teşekkürler

 

[YUSUF44]

Dosya yapınızı görmemiz için örnek bir dsoya eklemeniz iyi olacaktır. Hangi sütunda toplam yapılacak, sayfa üstüne nasıl bir ekleme yapılacak, sayfa altında nasıl belirtilecek; bunları görebilmemiz için örnek dosya önemli.

 

[yinan]

merhabalar

dosya ektedir.

tşk.

 

[YUSUF44]

Ben ayrı sekmelerde diye düşünmüştüm. sizin dosyanız tek sekmede altalta sayfalardan oluşuyor. Bu durumda ben yapamam maalesef

 

[yinan]

peki teşekkür ederim
sanırım manuel devam edeceğiz...

 

[Zeki Gürsoy]

Bu tip listeler için satır ekleme gibi teknikler uygulamak hem program kodu yazma açısından, hem de kontrol etme açısısndan zordur. Konuyla ben ilgilenemeyeceğim ancak çözüm üretmeye istekli arkadaşlar için fikir verebilirim.

- Kenar boşlukları ayarlanmış boş bir çalışma sayfası ve sütun başlıkları da yazılmış olmalı,
- Bu yeni çalışma sayfasında bir sayfa için düşen satır satır sayısını bul,
- Bu sayıdan 2 eksilt (her sayfanın başında nakli yekün, dibinde sayfa toplamı olacağı için),
- For - Next döngüsü

 

[Necdet]

Merhaba,

Aşağıdaki kodları deneyiniz. Tam kontrol etmedim.
2. satırdaki boş satırı sildim, onun yerine 1. satırın yüksekliğini ayarlayabilirsiniz.

Sub Duzenle()
 
    Dim i   As Long, _
        j   As Long, _
        Adt As Integer
 
    Application.ScreenUpdating = False
    On Error Resume Next
'    ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
    ActiveSheet.PageSetup.PrintTitleRows = "$1:$2"
 
    Cells.PageBreak = xlNone
    Columns("E:E").SpecialCells(xlCellTypeFormulas, 23).EntireRow.Delete 'E Sütununda Formüllü Satırlar Silinir
    i = Cells(Rows.Count, "A").End(3).Row
 
    ActiveSheet.PageSetup.PrintArea = "$A$1:$F$" & i
 
    Adt = 50 'sayfadaki satır sayısı
    i = 3
    j = 3
 
    Do
        i = i + Adt
        Rows(i & ":" & i + 1).Insert
        Cells(i, "D") = "DEVREDEN TOPLAM"
        Cells(i, "E") = "=SUM(E" & j & ":E" & i - 1 & ")"
        Cells(i, "F") = "=SUM(F" & j & ":F" & i - 1 & ")"
        ActiveWindow.SelectedSheets.HPageBreaks.Add before:=Range("A" & i + 1)
        Cells(i + 1, "D") = "ÖNCEKİ SAYFADAN DEVİR"
        Cells(i + 1, "E") = "=E" & i
        Cells(i + 1, "F") = "=F" & i
 
        i = i + 2
        j = i - 1
    Loop Until Cells(i + 1, "A") = ""
 
    Application.ScreenUpdating = True
    MsgBox "Düzenleme Bitmiştir....", vbInformation, "excel.web.tr, N. YEŞERTENER"
 
End Sub

 

[Necdet]

peki teşekkür ederim
sanırım manuel devam edeceğiz...

Çabuk teslim oldu, küstü sanırım Arkadaş bir daha gelmedi.