Soru Dinamik olarak form yazdırma makrosu hakkında yardım.

[mrc41353]

Merhabalar , ekte bulunan dosyada "GİRİŞ" sayfasında ki "Q" sütununda sadece "Yazıcı" (Bu alan tarih ile bağlantılı dinamiktir.) yazan hücrelerin bulunduğu satırlardaki "Yeşil renkli" hücrelerin
"FORM" adlı sayfadaki şablona yine "Yeşil renkli" hücrelere aktararak yazıcıdan çıktı alma döngüsü oluşturmak istiyorum. Yazdırılan hücre "Giriş" sayfasından silinmemelidir.
Konu ile ilgili yardımlarınız rica ederim.

 

[AdemCan]

Merhaba, aşağıdaki kodları kullanarak istediğiniz işlemi yapabilirsiniz.

Sub yazdir()
Application.ScreenUpdating = False

Dim giris As Worksheet, form As Worksheet
Dim son As Long, i As Long

Set giris = Sheets("GİRİŞ")
Set form = Sheets("FORM")

son = giris.Range("B" & Rows.Count).End(3).Row

For i = 2 To son
   If giris.Cells(i, "Q").Value = "Yazıcı" Then
        form.Range("D5").Value = giris.Cells(i, "L").Value
        form.Range("D6").Value = giris.Cells(i, "M").Value
        form.Range("D18").Value = giris.Cells(i, "N").Value
        form.Range("G5").Value = giris.Cells(i, "O").Value
   End If
form.PrintOut
Next i

Set giris = Nothing: Set form = Nothing
son = 0: i = 0
Application.ScreenUpdating = True
End Sub

 

[AdemCan]

Güncelleme bilgisi:
form.PrintOut satırını End If satırının üzerine alınız.
İlgili bölümün yeni hali.

If giris.Cells(i, "Q").Value = "Yazıcı" Then
        form.Range("D5").Value = giris.Cells(i, "L").Value
        form.Range("D6").Value = giris.Cells(i, "M").Value
        form.Range("D18").Value = giris.Cells(i, "N").Value
        form.Range("G5").Value = giris.Cells(i, "O").Value
form.PrintOut
   End If

 

[mrc41353]

Merhaba, aşağıdaki kodları kullanarak istediğiniz işlemi yapabilirsiniz.

Sub yazdir()
Application.ScreenUpdating = False

Dim giris As Worksheet, form As Worksheet
Dim son As Long, i As Long

Set giris = Sheets("GİRİŞ")
Set form = Sheets("FORM")

son = giris.Range("B" & Rows.Count).End(3).Row

For i = 2 To son
   If giris.Cells(i, "Q").Value = "Yazıcı" Then
        form.Range("D5").Value = giris.Cells(i, "L").Value
        form.Range("D6").Value = giris.Cells(i, "M").Value
        form.Range("D18").Value = giris.Cells(i, "N").Value
        form.Range("G5").Value = giris.Cells(i, "O").Value
   End If
form.PrintOut
Next i

Set giris = Nothing: Set form = Nothing
son = 0: i = 0
Application.ScreenUpdating = True
End Sub

Merhaba , ilginiz için teşekkür ederim makroyu ekleyerek dosyayı tekrar siteye yükledim , hata olarak sadece yazıcı yazan Q satırlarını değil listedeki bütün veri olan satırları yazıcıdan çıktı olarak veriyor döngü.

 

[mrc41353]

Güncelleme bilgisi:
form.PrintOut satırını End If satırının üzerine alınız.
İlgili bölümün yeni hali.

If giris.Cells(i, "Q").Value = "Yazıcı" Then
        form.Range("D5").Value = giris.Cells(i, "L").Value
        form.Range("D6").Value = giris.Cells(i, "M").Value
        form.Range("D18").Value = giris.Cells(i, "N").Value
        form.Range("G5").Value = giris.Cells(i, "O").Value
form.PrintOut
   End If

Evet bu defa oldu, emeklerinize sağlık teşekkür ederim...

 

[AdemCan]

Rica ederim.