• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

yazıcıdan hücre değeri kadar etiket bastırmak istiyorum

S

sonererim

Katılım
25 Ekim 2006
Mesajlar
31
Excel Vers. ve Dili
excel 2003 türkçe
herkese selamlar. kullanmış olduğum dosyamın sayfa1 deki f22 hücresinde yazan miktar kadar tambur etiket sayfasındaki etiketi çıkartmak istiyorum. hayırlı işler . selamlar
 

Ekli dosyalar

Aşağıdaki kodu deneyin.
Kod: 
Sub Yazdir()
Dim kopya As Long
kopya = Sayfa2.Range("F2")
Application.ScreenUpdating = False
Sayfa9.Select
    ActiveSheet.PageSetup.PrintArea = "$B$2:$D$11"
    ActiveWindow.SelectedSheets.PrintOut Copies:=kopya, Collate:=True, _
        IgnorePrintAreas:=False
        Sayfa2.Select
        Application.ScreenUpdating = True
        MsgBox kopya & "   adet etiket basılıyor...", vbInformation
End Sub
 
Sayfa1 deki Listeye Ekle butonunun kodlarını aşağıdaki şekilde değiştirin.
Kod: 
Private Sub CommandButton1_Click()
If WorksheetFunction.CountIf(Sheets("Liste").[O:O], Sheets("Sayfa1").[B2] & Sheets("Sayfa1").[C2]) > 0 Then
    MsgBox "Bu veri daha önce kaydedilmiş, mükerrer kayıt yapılamaz."
    Exit Sub
End If
    Adet = Sheets("Sayfa1").Range("f2")
    Sheets("TAMBUR ETİKET").PrintOut Copies:=Adet
    
    SatirBul
    
    'tarih M2
    Worksheets("Liste").Cells(KonumY, 1) = Worksheets("Sayfa1").Cells(2, 1)
    'musteri d3
    Worksheets("Liste").Cells(KonumY, 2) = Worksheets("Sayfa1").Cells(2, 2)
    'seri no m3
    Worksheets("Liste").Cells(KonumY, 3) = Worksheets("Sayfa1").Cells(2, 3)
    'toplam top sayısı g46
    Worksheets("Liste").Cells(KonumY, 4) = Worksheets("Sayfa1").Cells(2, 4)
    'toplam metre h46
    Worksheets("Liste").Cells(KonumY, 5) = Worksheets("Sayfa1").Cells(2, 5)
    'tarih M2
    Worksheets("Liste").Cells(KonumY, 6) = Worksheets("Sayfa1").Cells(2, 6)
    'musteri d3
    Worksheets("Liste").Cells(KonumY, 7) = Worksheets("Sayfa1").Cells(2, 7)
    'seri no m3
    Worksheets("Liste").Cells(KonumY, 8) = Worksheets("Sayfa1").Cells(2, 8)
    'toplam top sayısı g46
    Worksheets("Liste").Cells(KonumY, 9) = Worksheets("Sayfa1").Cells(2, 9)
    'toplam metre h46
    Worksheets("Liste").Cells(KonumY, 10) = Worksheets("Sayfa1").Cells(2, 10)
    'toplam metre h46
    Worksheets("Liste").Cells(KonumY, 13) = Worksheets("Sayfa1").Cells(2, 13)
    'toplam metre h46
    Worksheets("Liste").Cells(KonumY, 14) = Worksheets("Sayfa1").Cells(2, 14)
    'toplam metre h46
    Worksheets("Liste").Cells(KonumY, 16) = Worksheets("Sayfa1").Cells(2, 18)
    'Tarih
    Worksheets("Liste").Cells(KonumY, 11) = Date
    'Saat
    Worksheets("Liste").Cells(KonumY, 15) = Worksheets("Liste").Cells(KonumY, 2) & Worksheets("Liste").Cells(KonumY, 3)
    Worksheets("Liste").Cells(KonumY, 12) = Time
    MsgBox ("KANKİ LİSTEYE KAYDETTİK. HADİ YİNE İYİSİN.")
    'Range("D2:E2:F2:G2").ClearContents
    Range("D2").ClearContents
    Range("G2").Select
    With Worksheets(2).Range("Q2")
    .Value = .Value + 1
    End With
    
End Sub
 
askm' Alıntı:
Sayfa1 deki Listeye Ekle butonunun kodlarını aşağıdaki şekilde değiştirin.
Kod: 
Private Sub CommandButton1_Click()
If WorksheetFunction.CountIf(Sheets("Liste").[O:O], Sheets("Sayfa1").[B2] & Sheets("Sayfa1").[C2]) > 0 Then
    MsgBox "Bu veri daha önce kaydedilmiş, mükerrer kayıt yapılamaz."
    Exit Sub
End If
    Adet = Sheets("Sayfa1").Range("f2")
    Sheets("TAMBUR ETİKET").PrintOut Copies:=Adet
   
    SatirBul
   
    'tarih M2
    Worksheets("Liste").Cells(KonumY, 1) = Worksheets("Sayfa1").Cells(2, 1)
    'musteri d3
    Worksheets("Liste").Cells(KonumY, 2) = Worksheets("Sayfa1").Cells(2, 2)
    'seri no m3
    Worksheets("Liste").Cells(KonumY, 3) = Worksheets("Sayfa1").Cells(2, 3)
    'toplam top sayısı g46
    Worksheets("Liste").Cells(KonumY, 4) = Worksheets("Sayfa1").Cells(2, 4)
    'toplam metre h46
    Worksheets("Liste").Cells(KonumY, 5) = Worksheets("Sayfa1").Cells(2, 5)
    'tarih M2
    Worksheets("Liste").Cells(KonumY, 6) = Worksheets("Sayfa1").Cells(2, 6)
    'musteri d3
    Worksheets("Liste").Cells(KonumY, 7) = Worksheets("Sayfa1").Cells(2, 7)
    'seri no m3
    Worksheets("Liste").Cells(KonumY, 8) = Worksheets("Sayfa1").Cells(2, 8)
    'toplam top sayısı g46
    Worksheets("Liste").Cells(KonumY, 9) = Worksheets("Sayfa1").Cells(2, 9)
    'toplam metre h46
    Worksheets("Liste").Cells(KonumY, 10) = Worksheets("Sayfa1").Cells(2, 10)
    'toplam metre h46
    Worksheets("Liste").Cells(KonumY, 13) = Worksheets("Sayfa1").Cells(2, 13)
    'toplam metre h46
    Worksheets("Liste").Cells(KonumY, 14) = Worksheets("Sayfa1").Cells(2, 14)
    'toplam metre h46
    Worksheets("Liste").Cells(KonumY, 16) = Worksheets("Sayfa1").Cells(2, 18)
    'Tarih
    Worksheets("Liste").Cells(KonumY, 11) = Date
    'Saat
    Worksheets("Liste").Cells(KonumY, 15) = Worksheets("Liste").Cells(KonumY, 2) & Worksheets("Liste").Cells(KonumY, 3)
    Worksheets("Liste").Cells(KonumY, 12) = Time
    MsgBox ("KANKİ LİSTEYE KAYDETTİK. HADİ YİNE İYİSİN.")
    'Range("D2:E2:F2:G2").ClearContents
    Range("D2").ClearContents
    Range("G2").Select
    With Worksheets(2).Range("Q2")
    .Value = .Value + 1
    End With
   
End Sub
Genişletmek için tıkla ...
teşekkürler
 
turist' Alıntı:
Aşağıdaki kodu deneyin.
Kod: 
Sub Yazdir()
Dim kopya As Long
kopya = Sayfa2.Range("F2")
Application.ScreenUpdating = False
Sayfa9.Select
    ActiveSheet.PageSetup.PrintArea = "$B$2:$D$11"
    ActiveWindow.SelectedSheets.PrintOut Copies:=kopya, Collate:=True, _
        IgnorePrintAreas:=False
        Sayfa2.Select
        Application.ScreenUpdating = True
        MsgBox kopya & "   adet etiket basılıyor...", vbInformation
End Sub
Genişletmek için tıkla ...
teşekkürler
 
Sağolun.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst