yazdır aktar

[zerali]

Arkadaşlar benim bu dosyada yapmak istediğim şey ana sayfada seçtiğim öğrenciye mevcut yazıyı yazdırdıktan sonra kayıt sayfasına tarihine göre alt alta sıralayıp kaydetmesi. yardımlarınız için şimdiden teşekkürler.

 

[muygun]

Merhaba;
Eki deneyin.
İyi çalışmalar.

 

[zerali]

muygun hocam benim istediğimin fazlasını yapmışsınız.çook teşekkürler.Yalnız yazdır ve kaydet butonlarını ayırmamız mümkün olur mu.Olursa eğer başka çalışmalarda da bu taslağı kullanmayı düşünüyorum da.

 

[muygun]

Merhaba;
yazdırmayla ilgili tek satırlık bir kod var.
İsteğinize göre butonları ayırdım.
İnceleyin.
İyi çalışmalar.

Not: Yazıcım aktif olmadığından yazdırma sonucunu deneyemedim. Bilginiz olsun...

 

[zerali]

çok teşekkürler muygun hocam elinize sağlık.

 

[zerali]

bu konuyla ilgili olduğu için yeni bir konu açmadım
muygun hocam bu proğrama bazı ekler yapmak istiyorum.bir sayfada 2 belgemiz var bu belgelerin ikisininde V sütununda X koyduğum kişilerin sırayla kayıt edilmesini ve yazdırılmasını düşünüyorum ama böyle bir şey mümkün müdür bilmiyorum ve yardımlarınızı bekliyorum

 

[Emir Hüseyin Çoban]

. . .

Sub yazdır()
    Application.ScreenUpdating = False
    On Error Resume Next
    For i = 1 To [V65536].End(3).Row
        If Cells(i, "V") = "X" Or Cells(i, "V") = "x" Then
            Range("F8") = Cells(i, "W")
            ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
        End If
    Next i
    Application.ScreenUpdating = True
    MsgBox " B i t t i "
End Sub

Sub aktarr()
    Application.ScreenUpdating = False
    On Error Resume Next
    Set S1 = ThisWorkbook.Worksheets("ana")
    Set s2 = ThisWorkbook.Worksheets("kayıt")

    For i = 1 To S1.[V65536].End(3).Row
        If S1.Cells(i, "V") = "X" Or S1.Cells(i, "V") = "x" Then
            S1.Range("F8") = S1.Cells(i, "W")
            sonsatir = s2.Range("A65536").End(xlUp).Row + 1
            s2.Cells(sonsatir, 1) = sonsatir - 1
            s2.Cells(sonsatir, 2) = S1.Cells(9, "f")
            s2.Cells(sonsatir, 3) = S1.Cells(10, "f")
            s2.Cells(sonsatir, 4) = S1.Cells(8, "f")
            s2.Cells(sonsatir, 5) = S1.Cells(8, "n")
            s2.Cells(sonsatir, 6) = S1.Cells(21, "l")
            s2.Cells(sonsatir, 1).Borders.LineStyle = xlContinuous
            s2.Cells(sonsatir, 2).Borders.LineStyle = xlContinuous
            s2.Cells(sonsatir, 3).Borders.LineStyle = xlContinuous
            s2.Cells(sonsatir, 4).Borders.LineStyle = xlContinuous
            s2.Cells(sonsatir, 5).Borders.LineStyle = xlContinuous
            s2.Cells(sonsatir, 6).Borders.LineStyle = xlContinuous
        End If
    Next i
[COLOR="Green"]    'S1.Range("V:V").ClearContents ' ANA sayfa V sütununu temizlemek için aktif edin.[/COLOR]
    Application.ScreenUpdating = True
    MsgBox "İşlem TAMAM.", vbInformation
End Sub

. . .

 

[zerali]

Hüseyin Çoban Hocam çok teşekkürler denedim kod çalıştı ama 2 kişiyi yazdıracağım zaman 2 kağıt gidiyor.Aynı sayfada 2 kişiyi yazdırabilir miyiz.(yani A25 ile U51 arasında kalan ikinci belgede aktif olabilir mi)

 

[Murat OSMA]

İlave bilgi:

Kodlardaki bu satırların yerine,

[FONT="Trebuchet MS"]s2.Cells(sonsatir, 1).Borders.LineStyle = xlContinuous
s2.Cells(sonsatir, 2).Borders.LineStyle = xlContinuous
s2.Cells(sonsatir, 3).Borders.LineStyle = xlContinuous
s2.Cells(sonsatir, 4).Borders.LineStyle = xlContinuous
s2.Cells(sonsatir, 5).Borders.LineStyle = xlContinuous
s2.Cells(sonsatir, 6).Borders.LineStyle = xlContinuous[/FONT]

döngüden sonra bu tek satır kodu yazmanız yeterli olacaktır. ;

[FONT="Trebuchet MS"]s2.Cells(1, 1).[B][COLOR="Red"]CurrentRegion[/COLOR][/B].Borders.LineStyle = 1 [/FONT]

 

[Emir Hüseyin Çoban]

. . .

Bir kişi için 2 nüsha yazdırıyorsunuz değil mi ?

. . .

 

[zerali]

hayır hocam tek nüsha yazdırıyorum

 

[Emir Hüseyin Çoban]

. . .

Yazdırmak için şu kodları kullanın.
Not: Yazdırma sayısı tek olunca 1 tane boş çıkaracaktır.

Sub kod()
    Application.ScreenUpdating = False
    On Error Resume Next
    ReDim dizial(1 To 1, 1 To 1)
    For i = 1 To [V65536].End(3).Row
        If Cells(i, "V") = "X" Or Cells(i, "V") = "x" Then
            a = a + 1
            ReDim Preserve dizial(1 To 1, 1 To a)
            dizial(1, a) = Cells(i, "W")
        End If
    Next i
    i = Empty

    For i = 1 To a Step 2
        Range("F8") = dizial(1, i)
        Range("F36") = dizial(1, i + 1)
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
        Range("F8") = ""
        Range("F36") = ""
    Next i
    Application.ScreenUpdating = True
    MsgBox " B i t t i "
End Sub

. . .

 

[zerali]

hüseyin hocam yazdırma işini yapamadım kodda eksik mi var ben mi beceremedim acaba

 

[Emir Hüseyin Çoban]

. . .

Dosyanız ektedir.

. . .

 

[zerali]

çok teşekkürler hüseyin çoban hocam.elinize,emeğinize sağlık