etiket baskı yardımı

[fmt1976]

Arkadaşlar forumda arama yaptım ama bulduğum dosyalar silinmiş bana adres etiketi basabileceğim bir excel dosyası lazım

 

[Necdet]

Merhaba,

Bu işi Word çok iyi yapıyor, onu öneririm.

http://office.microsoft.com/tr-tr/word/HA010349201055.aspx

 

[fmt1976]

Hocam ben bunu yapmış olduğum excel programına eklemek istiyorum

 

[Necdet]

Merhaba,

Dosyanızı eklerseniz yardımcı olacak çok arkadaş çıkar.

 

[fmt1976]

ben sadece bir örnek istiyorum. Ben o örneğin üstünde çalışacağım. Yukarıda dediğim gibi arama sonucu bazı dosyalar buldum ama virüs yüzünden silinmişler.

 

[Necdet]

Merhaba,

Üzerinde çalışılsa güzel şeyler çıkabilir, basit bir çözüm sunuyorum size.

Bilindiği gibi standart etiketlerin satır ve sütun adedi etiket ölçüsüne göre değişmektedir. Ben örnekte sadece satır ve sütunu kontrol ettim, ama etiket aralıklarını dikkate almadım.

Siz Parametre sayfasında Etiket satırı ve sütununu giriniz.
Şablon sayfasını da kağıda sığacak şekilde ayarlayınız.

Sub EtiketListele()
Set sv = Sheets("Veri")
Set sp = Sheets("Parametre")
Set ss = Sheets("Şablon")
ss.[A1:E20].ClearContents
Dim i As Long
Dim Satır, Sütun, Kol, Kontrol, EtiketSütun, EtiketSatır As Integer
EtiketSütun = sp.[B1]
EtiketSatır = sp.[B2]
Sütun = 0
Satır = 1
For i = 2 To sv.[A65536].End(3).Row
    Sütun = Sütun + 1
    If Sütun > EtiketSütun Then
        Sütun = 1
        Satır = Satır + 1
        If Satır > EtiketSatır Then
'            ss.PrintOut
            ss.PrintPreview
            Satır = 1
            ss.[A1:E10].ClearContents
        End If
    End If
    Kol = Sütun + (Sütun - 1)
    
    ss.Cells(Satır, Kol) = sv.Cells(i, "A") & " " & sv.Cells(i, "B") & Chr(10) & _
                        sv.Cells(i, "C") & Chr(10) & _
                        sv.Cells(i, "D")
    
Next i
If ss.[A1] <> "" Then ss.PrintPreview
'If ss.[A1] <> "" Then ss.PrintOut
ss.[A1:E10].ClearContents
End Sub

Not : Word'ün bu işi daha iyi yaptığında ısrarlıyım.

 

[simalimben]

ama bu dosyanızda koruma var onu nasıl kaldıracağm?