• DİKKAT

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

Sayfayı yazdırırken sayfada hücrelere numara verdirmek?

udentr2002

Altın Üye
Katılım
5 Kasım 2006
Mesajlar
1,503
Excel Vers. ve Dili
iş yerinde Office 365
evde Office 365
Merhaba arkadaşlar,

Sayfayı etiket çıkartmak amaçlı kullanıyorum. Bana lazım olan şöyle bir şey tam olarak.

Sayfanın üzerindeki Etiket yazdır butonuna bastığımızda öncelikle pc ye kayıtlı yazıcıların seçimini yaptığımız nırmal yazdır penceresi çıkacak burda kopya sayısını belirtip yazdırdıktan sonra. diyelimki kopya sayısını 50 adet olarak girdik her sayfada 4 etiket çıkarttığı için 50x4=200 adet etiket çıkacak demektir. ekli dosyada da göreceğiniz gibi sarı işaretli olarak belirttiğim hücrelere (B4, F4, B23, F23) ilk sayfayı çıkartırken,
B4 hücresine 1
F4 hücresine 2
B23 hücresine 3
F23 hücresine 4
yazıp sayfanın çıktısını alacak 2. sayfayı çıkartırken

B4 hücresine 5
F4 hücresine 6
B23 hücresine 7
F23 hücresine 8
Yazıp sayfanın çıktısını alacak. 3. sayfayı çıkartırken

B4 hücresine 9
F4 hücresine 10
B23 hücresine 11
F23 hücresine 12
Yazıp sayfanın çıktısını alacak bu şekilde 200 olana kadar devam edecek.

Böyle bir şey mümkünmü acaba bu benim için çok önemli diğer şekilde gelip her sayfaya kendim numara veriyorum ve çok sayıda etiket çıkardığım için çok fazlası ile zaman kaybı benim için Bu konuda yardımcı olursanız çok sevinirim.

Not: kopya sayısını belirttiğimiz sayıyı 4 ile çarpıp o sayıya kadar numara verecek yani kopya sayısını 100 yaptığımızda 400 e kadar o belirtilen hücrelere numara verip her sayfayı çıktı alacak
 

Ekli dosyalar

Bu kodu denermisiniz.

Kod:
Sub yazdır()
adet = Application.InputBox("Kaç adet çıkartacaksınız.sayı olarak giriniz.", "sayı", "4", 400, 30, , Type:=1)
    
If adet = False Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If
sat = 1
For i = 1 To adet
MsgBox sat
Worksheets("cal").Cells(4, "B").Value = sat
Worksheets("cal").Cells(4, "F").Value = sat + 1
Worksheets("cal").Cells(23, "B").Value = sat + 2
Worksheets("cal").Cells(23, "F").Value = sat + 3
sat = sat + 4
Worksheets("cal").PageSetup.PrintArea = "$A$1:$H$36"
Worksheets("cal").PrintOut Copies:=1, Collate:=True
MsgBox i
Next
End Sub
 
Hocam.
Çok teşekkür ederim emeğinize bilginize sağlık.

Konu tam olarak yaptığınız gibi. Sadece her sayfayı yazdırırken gelen mesaj alanına tamam butonunu tıklıyoruz ya bu olmasa yani en başta kopya sayısını belirttiğimiz inputbox a girilen seçimden sonra tamam yıkladıktan sonra yazdırsın her sayfa için tekrar tamam tuşuna basmasak.


Allah razı olsun hakkınızı helal edin
 
Halit üstadım tekrar merhaba,

Gerek kalmadı sizin gönderdiğiniz kodlarda
msgbox sat ile
msgbox i

satırlarını kaldırınca dediğim gibi oldu.

Tekrar elinize ve bilginize sağlık çok teşekkürler üstadım.
 
Geri
Üst