Excelde Etİket Sorunu

[sunkid]

Merhaba ArkaŞlar Eklİ Dosyada Nacİzhane Kendİ Çapimda İÇİnden ÇikamadiĞim Bİ Sorunla KrŞikarŞiyayim Sİzlerden Yardimlarini BekledİĞİm Sorunu Eklİ Dosyada Anlattim Kisaca Burada Bahsedeyİm Elİmde 735 Tane Etİkete Bastirlacak Bİlgİler Var MalÜm 735 Tane Ve İÇİnd Ayri Ayri Krİterlerİ Olan Dosyayi Elle Kopyalayarak Yapmak GÜnerİmİ Alir Dosyayida İnceledİĞİnİzde GÖreeksİnİz İllakİ Excelte Yapilmasi Şart DeĞİl Worttede Hazirlanabİlİrse Bu ÇaliŞma Herhangİbİr Sorun TeŞkİl Etmez Yardimlariniz İÇİn Şİmdİden TeŞekkÜr Ederİm....

 

[microaim]

ekteki dosyayı incelermisiniz.işinizi göreceğine inanıyorum.

 

[microaim]

bu daha fazla işini görecek gibi...öncekinde 735 sayfa yazdıracaktı.bunda ise sadece a b ve c sütunlarına yazdıgın veri kadar sayfa yazdıracak...

 

[Necdet]

Merhaba,

Aşağıdaki linki incelerseniz rahatlıkla yapabileceğinizi düşünüyorum.

http://www.excel.web.tr/showthread.php?t=6935&highlight=etiket+a%E7%FDklamas%FD

 

[sunkid]

öncelikle arkaşlar ilginizden ötürü sonzu şükranlarımı sunarım fakat arkadaşlar sizden istedğim şablon değişti sizleride uğraştırdım kusurabakmayın. şimdi istediğim ekteki dosyadada göreceksiniz excelde hali hazırda bekleyen 735 adet veri var bunu wordte bir A4 kağıdına (4 tane tablo) olacak şekilde yerleştirmek yolladığım örneğide inceledikten sonra daha iyi anlayacağıızı düşünüyorum ilginiz için tekrar çok teşekkür ederim...

 

[sunkid]

ArkadaŞlar Acİl Yardim

 

[Necdet]

Merhaba,

2. sayfaya aktarıp liste aldırdım. 2. sayfadaki çizgileri kaldırıp sayfaya göre satır, sütun ve fontu ayarlayabilirsiniz.

PrintPreview evde yazıcı olmadığı için denemek açısından koydum, o satırları kaldırıp kırmızı satırı devreye sokarsanız doğrudan tanımlı yazıcıya yazar.

Public Sub Yazdir()
Set s1 = Sheets(1)
Set s2 = Sheets(2)
s1.Select
For i = 2 To [A65536].End(3).Row
    j = j + 1
    s2.Cells(j, "A") = s1.Cells(i, "A") & Chr(10) & _
                      s1.Cells(i, "B") & Chr(10) & _
                      s1.Cells(i, "C")
    If j = 4 Then
        s2.PrintPreview
[B][COLOR=red]'        s2.PrintOut
[/COLOR][/B]        j = 0
    End If
Next i
If j > 0 Then s2.PrintPreview
[B][COLOR=red]'If j > 0 Then s2.PrintOut
[/COLOR][/B]End Sub