Yazdırılan bilgileri arşiv sayfasına aktarma

[vurkan]

Excel Versiyonu

Excel 2016

Excel Sürümü

64 Bit

Excel Dili

Türkçe

Arkadaşlar Merhaba. Müdür Yardımcımın isteği üzerine birkaç dosyayı birleştirerek bir Öğrenci izin programı hazırladım.
Bu dosyada dilekce sayfasında öğrenci bilgileri yazıcıya gönderildikten sonra o öğrencinin sınıfı numarası adı soyadı izin tarihi ve saatinin arşiv şayfasına aktarılmasını istiyorum. Aynı öğrenci başka bir tarihte tekrar izin alırsa yeni bir satıra değil daha önceki satırın devamına sadece tarih ve saati eklemesi yerli. Her öğrenci bu şekilde arşive aktarıldığında öğrencinin izin geçmişini gözlemlemek istiyorum. Bunun için aşağıdaki yazıcı kodlarına nasıl bir ilave yapmalıyım? Saygılar sunuyorum.

Sub yazdır_1()
ActiveSheet.PageSetup.PrintArea = "$A$1:$L$15"
ActiveSheet.PrintOut
End Sub

 

Satır Satır Ayın Kaçı Tarihin Başlama

Şifre üç kere yanlış girilirse uyarı çıksın

[okutkan]

Telefonda yazdığım için hata kontrolü yapamadım. Deneyip geri dönüş yaparsınız.

Sub yazdır_1()
set arsiv = sheets("ARŞİV")
set dilekce = sheets("dilekce")
son = arsiv.Cells(Rows.Count, 2).End(3).Row + 1
arsiv.range("A" & son) = son - 1

saat = format(dilekce.range("c29"), "hh:mm")
tarih= format(dilekce.range("c28"), "dd.mm.yyyy")
arsiv.range("B" & son) = dilekce.range("c26") 'sınıf
arsiv.range("C" & son) = dilekce.range("c25") 'numara
arsiv.range("D" & son) = dilekce.range("c27") 'isim
arsiv.range("E" & son) = tarih 'tarih
arsiv.range("F" & son) = saat 'saat

ActiveSheet.PageSetup.PrintArea = "$A$1:$L$15"
ActiveSheet.PrintOut
End Sub

 

[okutkan]

Daha önce kayıtlı olan öğrenci izni yazdırılırken tarih ve saat bilgisini yeni satıra eklememesi konusunu yeni farkettim. Verdiğim kodda her seferinde yeni satıra ekleme yapar.

 

[vurkan]

Üstadım. Sonradan farkettiğiniz hususun yanında bir de sıra numarası 2 den başlıyor. Bunun haricinde kodlar gayet güzel çalışıyor. Saygılar sunuyorum.

 

[okutkan]

Kodu düzenledim. Bu şekliyle yine işinizi görmeyecekse, başka bir arkadaşımız yardımcı olacaktır.

 

[vurkan]

Teşekkür ediyorum bu şekilde de kullanabilirim. Saygılar.

 

[Ömer BARAN]

Merhaba @vurkan

Eklediğim belgede birkaç düzenleme yaptığım için denemelerinizi bu belgede yapın.
Oluşturduğum kod ise şöyle.

Aynı kayıt (tüm bilgiler) olduğunda tekrar yazdırmak istemiyorsanız
ya da yazdırma öncesi ONAY istemeyi düşünürseniz kodda küçük düzenleme gerekir.

Sub yazdır_1()
Dim varmi As Long
Set a = Sheets("ARŞİV")
Set d = Sheets("dilekce")

s = a.Cells(Rows.Count, 2).End(3).Row

If s > 1 Then
    varmi = Evaluate("=SUMPRODUCT((ARŞİV!$B$2:$B" & s & "=dilekce!$C$4)*(ARŞİV!$C$2:$C" & s & _
                    "=dilekce!$c$3)*(ARŞİV!$D$2:$D" & s & "=dilekce!$C$5)*(ARŞİV!$E$2:$E" & s & _
                    "=dilekce!$C$6)*(TIME(HOUR(ARŞİV!$F$2:$F" & s & "),MINUTE(ARŞİV!$F$2:$F" & s & _
                    "),0)=TIME(HOUR(dilekce!$C$7),MINUTE(dilekce!$C$7),0)))")
End If

If varmi = 0 Then
    XDs = a.Cells(Rows.Count, 3).End(3).Row + 1
    On Error Resume Next
    XDss = a.Range(a.Cells(1, 3), a.Cells(Rows.Count, 3)).Find(d.[C3], , , , xlByRows, xlPrevious).Row
    On Error GoTo 0
    If Not XDss = Empty Then XDs = XDss + 1
    If XDs>2 Then a.Rows(XDs).Insert
    a.Cells(XDs, 2) = d.[C4].Value: a.Cells(XDs, 3) = d.[C3].Value
    a.Cells(XDs, 4) = d.[C5].Value: a.Cells(XDs, 5) = d.[C6].Value
    a.Cells(XDs, 6) = d.[C7].Value
    XD = a.Cells(Rows.Count, 2).End(3).Row
    a.Range("A2:A" & XD) = Evaluate("=ROW(A2:A" & XD & ")-1")
Else
    MsgBox "AYNI KAYIT VAR !", vbInformation
End If
ActiveSheet.PageSetup.PrintArea = "$A$1:$L$15"
ActiveSheet.PrintOut
End Sub

 

[vurkan]

Merhaba Ömer BARAN Üstadım. Verdiğiniz kodlar gayet güzel. Ancak satır eklerken başlık satırının formatında (Aynı yükseklik ve aynı dolgu rengiyle) oluşuyor. Nasıl düzelteceğimi de bulamadım. Saygılar

 

[Ömer BARAN]

Koddaki a.Rows(XDs).Insert satırını If XDs>2 Then a.Rows(XDs).Insert olarak değiştirmek yeterli olur.
Önceki cevabımda gerekli düzeltmeyi yaptım.

 

[vurkan]

Teşekkür ediyorum üstadım. Affınıza sığınarak bir şey daha sorsam;
Birden fazla yazıcı bağlı olan bir bilgisayarda bu dosyayı varsayılana değil de diğer yazıcıya göndermek mümkün mü acaba? İzin kağıdı A4 boyutunda olmadığı için her seferinde kağıt değiştirmekten daha kullanışlı olur zannedersem. Saygılar.

 

[Ömer BARAN]

Şöyle bir yapı olması lazım.
Yazıcının adını kendinize göre değiştirerek deneyin.

ActiveSheet.PrintOut Copies:=1, ActivePrinter:="Ne00: üzerindeki P-3025 MFP KX", Collate:=True, IgnorePrintAreas:=False

En azından şu kodu ayrı bir makro olarak çalıştırın,
açılacak listeden ilgili yazıcıyı seçip işlemi tamamlayın.
A1 hücresine yazdırılan yazıcı adını, yukarıdaki kod satırında yerine koyun.

Sub HANGI_YAZICI()
    Application.Dialogs(xlDialogPrinterSetup).Show
    [A1] = Application.ActivePrinter
End Sub

 

[vurkan]

Üstadım çok teşekkür ediyorum.