Etiket baskısı için listeyi yazdırmak

[BeaLzeBuB]

Ekteki dosyayı incelerseniz "etiket" sayfasındaki satır ve sutunları baya bir küçülttüm. defalarca denememe rağmen ancak bu şekilde baskıya hazırlayabildim.

benim istediğim etket sayfasında "davetli 1,2,3" diye yazan yerlere gelecek bilgileri, liste sayfasından alması.

bunu nasıl yapabiliriz ?


benzer bir konu var ama orada verilen excel dosyasının çıktısını benim ellimdeki kağıt ve yazıcı kenar boşluklarına göre ayarlayamadım.

elimdeki etiketler A4 sayfada 3x4=12 adet

 

[Ömer]

Merhaba,

Module kopyalayıp çalıştırınız.

Sub EtiketYazdir()
 
    Dim i As Long, sat As Long, sut As Integer, Sl As Worksheet
    Dim Etiket_Satir_Adedi As Long, Etiket_Sutun_adedi As Integer
    Dim sayac As Long
 
    Set Sl = Sheets("liste")
 
    Etiket_Satir_Adedi = 4
    Etiket_Sutun_adedi = 3
 
    Application.ScreenUpdating = False
 
    If Sl.Range("A1") = "" Then Exit Sub
 
    Sheets("etiket").Select
    Cells.ClearContents
 
    sat = 2: sut = 1
    For i = 1 To Sl.Cells(Rows.Count, "A").End(xlUp).Row
        sayac = sayac + 1
        If sayac > Etiket_Satir_Adedi * Etiket_Sutun_adedi Then
            sat = 2: sut = 1
            ActiveSheet.PrintOut
            Cells.ClearContents
            sayac = 1
        End If
        If (sayac - 1) Mod Etiket_Sutun_adedi = 0 And sayac <> 1 Then
            sat = sat + 22
            sut = 1
        End If
        Cells(sat, sut) = Sl.Cells(i, "A")
        sut = sut + 9
    Next i
 
    ActiveSheet.PrintOut
    Cells.ClearContents
    Application.ScreenUpdating = True
 
End Sub