Soru Başka Sayfadan Veri Çekerek Önlü Arkalı Çıktı Alma (Makro)

[serdar.gul]

Merhaba ,

aşağıdaki örnek dosyamda şunu yapmak istiyorum;

Çıktı sayfasındaki AK4 ve AK41 satırlarında "1" rakamı yazıyor. Buradaki rakamın data sayfasındaki A18 den sırasıyla başlayarak otomatik olarak olarak değişmesi ve değişirken de önlü arkalı çıktı almasını istiyorum. data sayfasındaki A satırında ne zaman boş oldu o zaman çıktı alma işlemi duracak. şekilde bir kod yazmak mümkün müdür?

yardımcı olabileceklere teşekkürler.

Dosya İndirme Linki

 

[serdar.gul]

Merhaba ,
konu günceldir yardımınızı rica ederim arkadaşlar

 

[Ömer]

Merhaba,

Deneyiniz.

Sub yazdir()
    
    Dim S1 As Worksheet, S2 As Worksheet, i As Long, say As Long
    
    Set S1 = Sheets("Data Sayfası")
    Set S2 = Sheets("Çıktı Sayfası")
    
    Application.Dialogs(xlDialogPrinterSetup).Show 'bu satır çift taraflı yazdırma ayarını yapmanız içindir.
    
    say = Application.Max(S1.Range("A18:A" & Rows.Count)) + 18 - 1
    
    For i = 18 To say
        If S1.Cells(i, "A") <> "" Then
            S2.Range("AK4") = S1.Cells(i, "A")
            S2.PrintOut
            Application.Wait (Now + TimeValue("00:00:01"))
        End If
    Next i
        
End Sub

 

[serdar.gul]

Merhaba,

Deneyiniz.

Sub yazdir()

    Dim S1 As Worksheet, S2 As Worksheet, i As Long, say As Long

    Set S1 = Sheets("Data Sayfası")
    Set S2 = Sheets("Çıktı Sayfası")

    Application.Dialogs(xlDialogPrinterSetup).Show 'bu satır çift taraflı yazdırma ayarını yapmanız içindir.

    say = Application.Max(S1.Range("A18:A" & Rows.Count)) + 18 - 1

    For i = 18 To say
        If S1.Cells(i, "A") <> "" Then
            S2.Range("AK4") = S1.Cells(i, "A")
            S2.PrintOut
            Application.Wait (Now + TimeValue("00:00:01"))
        End If
    Next i
    
End Sub

________________

Ömer Bey ,

Yardımınız için teşekkürler.
bir isteğim daha olacak. Adem arkadaşımız aşağıdaki kodu yazmıştı pdf olarak kayıt yapıyor. Aşağıdaki kodu sizin vermiş olduğunuz koda uyarlaya bilir miyiz? uyarlarken de direkt masa üstüne değil de benim oluşturmuş olduğum herhangi bir klasörün içerisine atacak şekilde düzenlene şansımız var mıdır? (koddan ben klasör ismini manuel değiştirebileceğim). Yani önce önlü arkalı yazdıracak sonra benim belirttiğim klasörün içerisine kayıt yapacak sonra bir sonraki yazdırmaya geçerek devam edecek

Dim S1 As Worksheet, konum As String, adi As String, uzanti As String

Set S1 = Sayfa1 'çıktı alınacak sertifika sayfası
ActiveSheet.Unprotect
konum = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
adi = S1.Range("L9") & " 7 NOKTA VE ZULA - DUR-KALK FORMU (" & S1.Range("L11") & " - " & S1.Range("AE11") & ") " & S1.Range("L12")
uzanti = ".pdf"

S1.ExportAsFixedFormat Type:=xlTypePDF, Filename:=konum & adi & uzanti
ActiveSheet.Protect

 

[serdar.gul]

arkadaşlar merhaba ,

kod bilgisine sahip olan arkadaşlardan yardım bekliyorum

ömer beyin yazmış olduğu kod ile benim mesajda belirtmiş olduğum kodu birleştirebilir miyiz?

 

[Ömer]

Nasıl bir birleştrme istiyorsunuz. Aynı anda hem yazdırıp hem de .pdf mi oluşturacak? Daha detaylı açıklama yapınız.

 

[serdar.gul]

Nasıl bir birleştrme istiyorsunuz. Aynı anda hem yazdırıp hem de .pdf mi oluşturacak? Daha detaylı açıklama yapınız.

Ömer bey,

aynen yazdırdıktan sonra masaüstünde benim belirtmiş olduğum klasör içerisine (klasör ismini koddan manuel değiştirebileceğim) pdf olarak kayıt yapacak. klasöre kayıt yaparken de aşağıdaki koddaki hücrelerden veriyi çekip pdf adı olarak kayıt yapmış olacak
S1.Range("L9") & " 7 NOKTA VE ZULA - DUR-KALK FORMU (" & S1.Range("L11") & " - " & S1.Range("AE11") & ") " & S1.Range("L12")

 

[serdar.gul]

arkadaşlar merhaba ,

kod bilgisine sahip olan arkadaşlardan yardım bekliyorum

ömer beyin yazmış olduğu kod ile benim mesajda belirtmiş olduğum kodu birleştirebilir miyiz?