Bütün formu bir kerede doldurabilmek.

[Mukteda]

Arkadaşlar Merhaba,

Bu bir yapışkanlı etiket şablonu. Lazer yazıcıdan çıktı alarak ilgili bölümlere veriyorum.

Bu işaretli bölümde formül var. Yukarıya kodunu yazdığımda alta adı geliyor. Ve bunu her bir etiket için tek tek yapıyorum.

Ekteki veri sayfasından hepsini birden nasıl yazdırabilirim?


Not: Formüller biraz ama makrolar ile hiç aram yok. Cahilliğimi lütfen mazur görün.

 

[Mukteda]

Arkadaşlar, Kıymetli büyüklerim,

Hafta başı dış denetimimiz var. Konu biraz acil. Mümkün ise hemen bakabilir misiniz?

Şükranlarımla.

 

[Korhan Ayhan]

Merhaba,

Ekteki örnek dosyayı incelermisiniz. Eğer yazdırma için onay istemiyorsanız kırmızı renkli satırları silin.

Uygulanan kod;

Option Explicit
 
Sub ETİKET_YAZDIR()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim X As Long, Y As Byte, Satır As Byte
 
    Set S1 = Sheets("Veri")
    Set S2 = Sheets("0001")
 
    For X = 1 To S1.Cells(Rows.Count, 1).End(3).Row Step 14
        Satır = X
        For Y = 3 To 57 Step 9
            S2.Cells(Y, "B") = S1.Cells(Satır, 1)
            S2.Cells(Y, "V") = S1.Cells(Satır + 1, 1)
            Satır = Satır + 2
        Next
        [COLOR=red]If MsgBox("Sayfayı yazdırmak istiyor musunuz?", vbYesNo, "Yazdırma İşlemi") = vbNo Then GoTo Devam[/COLOR]
        S2.PrintOut
[COLOR=red]Devam:[/COLOR]
    Next
 
    Set S1 = Nothing
    Set S2 = Nothing
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Mukteda]

Elim ayağım bir birine dolaştı. Denetim sebebi ile masam dağ gibi...

Çok özür dilerim. Visual basic projeleri ile hiç uğraşmadım. O dosyaya bu kodları nasıl import edebilirim?

 

[Mukteda]

Afedersiniz ekteki gönderdiğiniz dosyayı görmemiştim.

Denedim çok güzel olmuş elinize sağlık. Yalnız sayfanın yarısı boş kalıyor. Bunu en aşağıya kadar nasıl çekebiliriz?

Bir de her defasında yazdırmak isyormusun diye sormasın. Kendim kontrol edeyim ondan sonra yazdırayım.

Saygılarımla

 

[Korhan Ayhan]

Merhaba,

Ekteki örnek dosyayı incelermisiniz. Sarı renkli hücre içini silerseniz tekrar ilk satırdan itibaren verileri aktarır.

Uygulanan kod;

Option Explicit
 
Sub ETİKET_YAZDIR()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim X As Long, Y As Byte, Satır As Byte, Eski_Veri As Long
    
    Set S1 = Sheets("Veri")
    Set S2 = Sheets("0001")
    
    If S2.Range("AS1") = "" Then S2.Range("AS1") = 1
    Eski_Veri = S2.Range("AS1")
    
    For X = S2.Range("AS1") To S1.Cells(Rows.Count, 1).End(3).Row Step 14
        Satır = X
        For Y = 3 To 57 Step 9
            S2.Cells(Y, "B") = S1.Cells(Satır, 1)
            S2.Cells(Y, "V") = S1.Cells(Satır + 1, 1)
            Satır = Satır + 2
        Next
        S2.Range("AS1") = Satır
        If Eski_Veri <> S2.Range("AS1") Then GoTo Devam
    Next
    
Devam:
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox "Verilerinizi kontrol edip yazdırabilirsiniz.", vbInformation
End Sub

 

[Mukteda]

Mükemmel oldu.

Samimiyetle ifade etmeliyim ki "Size minnettarım..."

Çalışmalarınızda üstün başarı ve kolaylıklar dilerim.