etiket yapımı

[unfourgiven]

arkadaşlar kolay gelsin.

18'lik etiket basmak istiyorum. (18'li etiketin her sayfasında 3 sutün ve 6 satır var) liste sayfasındaki dolu olan satırlardaki verileri değer olarak 3 sutun halinde etiket sayfasına aktarmak istiyorum. sayfaya akatrıyorum fakat 3 sutüna paylaştıramıyorum.
dosya ektedir.

 

[Necdet]

Merhaba,

Aşağıdaki kodlar her satıra 3 ve her sayfaya 6 satır etiket aktardıktan sonra Baskı Ön İzleme yaptırır.

Siz doğrudan yazdıracaksanız kırmızı satırı silip Yeşil satırın başındaki tırnağı kaldırın.

Sub EtiketYazdir()
Dim i As Long
Dim Kol As Integer, Sat As Integer
Dim se As Worksheet, sl As Worksheet
Set se = Sheets("ETİKET")
Set sl = Sheets("Liste")
Sat = 1
Kol = 1
For i = 2 To sl.[A65536].End(3).Row
    se.Cells(Sat, Kol) = sl.Cells(i, "B") & Chr(10) & _
                        "Tel : " & sl.Cells(i, "D") & Chr(10) & _
                        sl.Cells(i, "C") & Chr(10) & _
                        sl.Cells(i, "E") & Chr(10) & _
                        sl.Cells(i, "A")
    Kol = Kol + 1
    If Kol > 3 Then
        Kol = 1
        Sat = Sat + 1
        If Sat > 6 Then
 [B][COLOR=red]           se.PrintPreview[/COLOR][/B]
[COLOR=green][B]'            se.PrintOut
[/B][/COLOR]            Sat = 1
            se.Range("A1:C6").ClearContents
        End If
    End If
Next i
MsgBox "işlem tamamdır..."

End Sub

 

[unfourgiven]

abi teşekkür ediyorum. elinize sağlık. şöyle nasıl yapabilirim. liste sayfasındaki d sutününü ekitek sayfasına aktarabilirmiyiz.

 

[Necdet]

Merhaba,

Sadece D sütunu (telefonları) etiket sayfasına aktarıp ta mı dökmek istiyorsunuz?

 

[unfourgiven]

abi f sutünunda ordaki bilgileri birleştirdim. sadece f sutununu etiket sayfasına aktarmak istiyorum.

 

[Necdet]

Merhaba,

Benim önerdiğim çözümde zaten Etiket sayfasında birleştiriyor. Gereksiz yere exceli şişirmemek gerek.

 

[unfourgiven]

hocam teşekkür ediyorum. elinize sağlık.

 

[unfourgiven]

hocam baskı önizlemede her bir sayfayı tek tek yazdımam gerekiyor. bunu tek seferde nasıl yazdırabiliriz.

 

[Necdet]

Merhaba,

2. mesajımda verdiğim kodlarda bazı satırları kırmızı, bazısını da yeşil yaptım. Bununda nedenini açıkladım ama sanırım dikkat etmediniz.

Kodda
se.PrintPreview
satırını silin
se.PrintOut satırının başındaki tek tırnağı kaldırın.

 

[unfourgiven]

hocam hatırlmatmanız iyi oldu sizi yordu kusura bakmayın ilginize teşekkür ediyoruz.

 

[Necdet]

Rica ederim, güle güle kullanınız.