• DİKKAT

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

Çıktı Listesi

Katılım
28 Ağustos 2013
Mesajlar
118
Excel Vers. ve Dili
Excel 2013 - Tr
Merhaba, Forum Halkı..

Benim bi çıktı listem var.

Her defasında yeni bir satıra gerekli konu ve içeriğini yazıp kayıt yapıyorum.

İstediğim; Her defasında bi alt satıra eklemiş olduğum dökümanların en sağında yazdır tıkladığımda ikinci sayfa şablonuna aktarıp ya da aktarmadan sadece ilgili satırdaki dökümanları ikinci sayfa düzenine göre yazdırmasını istiyorum.

Nkyl2N.jpg


http://s4.dosya.tc/server3/gqp0ab/Cikti_Listesi.rar.html

Bu konuda yardımcı olursanız sevinirim. Teşekkürler.
 
Aşağıdaki kodları Sayfa1'in kod bölümüne yapıştırın (Sayfa1 sekmesine sağ tıklayıp kod görüntüle deyince açılan sayfa):
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [G:G]) Is Nothing Then Exit Sub
If Target = "YAZDIR" Then
    a = Target.Row
    Sheets("Sayfa2").[A5] = Cells(a, "A")
    Sheets("Sayfa2").[B5] = Cells(a, "B")
    Sheets("Sayfa2").[C5] = Cells(a, "C")
    Sheets("Sayfa2").[D5] = Cells(a, "D")
    Sheets("Sayfa2").[A8] = Cells(a, "F")
    Sheets("Sayfa2").PrintOut
End If
End Sub

Kod G sütununda YAZDIR yazılı bir hücreye tıkladığınızda istediğiniz işlemi yapar.
 
Aşağıdaki kodları Sayfa1'in kod bölümüne yapıştırın (Sayfa1 sekmesine sağ tıklayıp kod görüntüle deyince açılan sayfa):
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [G:G]) Is Nothing Then Exit Sub
If Target = "YAZDIR" Then
    a = Target.Row
    Sheets("Sayfa2").[A5] = Cells(a, "A")
    Sheets("Sayfa2").[B5] = Cells(a, "B")
    Sheets("Sayfa2").[C5] = Cells(a, "C")
    Sheets("Sayfa2").[D5] = Cells(a, "D")
    Sheets("Sayfa2").[A8] = Cells(a, "F")
    Sheets("Sayfa2").PrintOut
End If
End Sub

Kod G sütununda YAZDIR yazılı bir hücreye tıkladığınızda istediğiniz işlemi yapar.

Hocam ellerinize sağlık. Yazdırınca direk göndermek değil de yazdırıcalacak emin misiniz? Diye bi uyarıyıda verebilir mi? Teşekkürler.
 
Aşağıdaki gibi deneyiniz:
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [G:G]) Is Nothing Then Exit Sub
If Target = "YAZDIR" Then
    a = Target.Row
    Sheets("Sayfa2").[A5] = Cells(a, "A")
    Sheets("Sayfa2").[B5] = Cells(a, "B")
    Sheets("Sayfa2").[C5] = Cells(a, "C")
    Sheets("Sayfa2").[D5] = Cells(a, "D")
    Sheets("Sayfa2").[A8] = Cells(a, "F")
    uyarı = MsgBox("Sayfa2 aşağıdaki bilgilerle yazdırılacak, onaylıyor musunuz?" & Chr(10) & Chr(10) & _
            "Kategori: " & Cells(a, "A") & Chr(10) & Chr(10) & "Alt Kategori: " & Cells(a, "B") & Chr(10) & Chr(10) & _
            "Tarih: " & WorksheetFunction.Text(Cells(a, "C"), "dd/mm/yyyy") & Chr(10) & Chr(10) & _
            "Ekleyen Kişi: " & Cells(a, "D") & Chr(10) & Chr(10) & "Konu: " & Cells(a, "E") & Chr(10) & Chr(10) & _
            "İçerik: " & Cells(a, "F"), vbYesNo)
    If uyarı = vbYes Then Sheets("Sayfa2").PrintOut
End If
End Sub
 
Geri
Üst