• DİKKAT

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

Soru Koli üstü yazdırma

C

clawee

Katılım
2 Şubat 2010
Mesajlar
25
Excel Vers. ve Dili
2007
Arkadaşlar siteden bu kodu buldum. Amacı her baskıdan onra 1 değer arttırıp yazdırması. Ben bunu koli üstü etiket yazdırmada kullanıyorum. Yani 100 baskı yapıcaksam girdiğim hücre değerini 1 er adet arttırararak yazdırıyor. Yani 1-2-3 ..100 e kadar koli etiketi. Ama ben her baskıyı 2 adet yazdırsın istiyorum. Yani 1. koliden 2 adet 2 koliden 2 adet gibi kaç koli varsa. Bu konuda bilgim yetersiz nasıl yapabilirim.

Teşekkürler.


Sub IncrementPrint()
'updateby Extendoffice 20160530
Dim xCount As Variant
Dim xScreen As Boolean
Dim I As Long
On Error Resume Next
LInput:
xCount = Application.InputBox("Please enter the number of copies you want to print:", "Kutools for Excel")
If TypeName(xCount) = "Boolean" Then Exit Sub
If (xCount = "") Or (Not IsNumeric(xCount)) Or (xCount < 1) Then
MsgBox "error entered, please enter again", vbInformation, "Kutools for Excel"
GoTo LInput
Else
xScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
For I = 1 To xCount
ActiveSheet.Range("V1").Value = " " & I
ActiveSheet.PrintOut
Next
ActiveSheet.Range("A1").ClearContents
Application.ScreenUpdating = xScreen
End If
End Sub
 
Merhaba,
ActiveSheet.PrintOut satırını Activesheet.PrintOut Copies:=2 şekilde değiştirip deneyiniz.
 
Rica ederim,
İyi çalışmalar...
 
Merhaba, Konu çok eski ama kusuruma bakmayın.
Bana bu tarz 100 etiket basmak istediğimde her barkodun sonuna 1/100 2/100 şeklinde kaçıncı barkod olduğunu belirtecek şeklinde nasıl çıktı alabilirim.
 
Merhabalar sizinde yardımızda koli üstü yazdırmak için bu kodlamayı yaptık. Ancak burda yazdırma işleminde sayı artışını 1 den başlayarak 1-3-5 ... yani 2 şer artarak yazdırmasını istiyorum yardımcı olabilecek arkadaşlara şimdiden teşekkür ederim.

Sub IncrementPrint()
'updateby Extendoffice 20160530
Dim xCount As Variant
Dim xScreen As Boolean
Dim I As Long
On Error Resume Next
LInput:
xCount = Application.InputBox("Please enter the number of copies you want to print:", "Kutools for Excel")
If TypeName(xCount) = "Boolean" Then Exit Sub
If (xCount = "1") Or (Not IsNumeric(xCount)) Or (xCount < 1) Then
MsgBox "error entered, please enter again", vbInformation, "Kutools for Excel"
GoTo LInput
Else
xScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
For I = 1 To xCount
ActiveSheet.Range("L1").Value = " " & I
ActiveSheet.PrintOut Copies:=1
Next
ActiveSheet.Range("A1").ClearContents
Application.ScreenUpdating = xScreen
End If
End Sub
 
clawee' Alıntı:
Merhabalar sizinde yardımızda koli üstü yazdırmak için bu kodlamayı yaptık. Ancak burda yazdırma işleminde sayı artışını 1 den başlayarak 1-3-5 ... yani 2 şer artarak yazdırmasını istiyorum yardımcı olabilecek arkadaşlara şimdiden teşekkür ederim.
Genişletmek için tıkla ...
Merhaba,
For I = 1 To xCount satırını For I = 1 To xCount Step 2 şeklinde değiştirip deneyiniz...
 
Merhaba
Denedim ancak sadece 2 baskı veriyor 1 ve 3 devamı gelmiyor.
 
Bunu siz belirliyorsunuz. Kodu çalıştırınca açılan inputbox'a girdiğiniz veriye kadar yazdırma yapar.
Bu şekilde işinizi dörmüyorsa önceki değişikliği iptal edip ActiveSheet.Range("L1").Value = " " & I satırını ActiveSheet.Range("L1").Value = " " & I * 2 - 1 şeklinde değiştirip deneyiniz.
 
Ömer bey teşekkür ederim bu şekilde tam istediğim gibi oldu.
 
Merhabalar sizlerin yardımıyla aşağıdaki kodlamayı ayarladık ancak sadece 1 sayfa yazdıracağımda hata veriyor. 2 yada daha fazla yazdırmam gerekiyor. Bunun içinde kağıt israfı yaratıyoruz. Nasıl bir düzenleme yapabilirim.

Teşekkürler

Sub IncrementPrint()
'updateby Extendoffice 20160530
Dim xCount As Variant
Dim xScreen As Boolean
Dim I As Long
On Error Resume Next
LInput:
xCount = Application.InputBox("Please enter the number of copies you want to print:", "Kutools for Excel")
If TypeName(xCount) = "Boolean" Then Exit Sub
If (xCount = "1") Or (Not IsNumeric(xCount)) Or (xCount < 1) Then
MsgBox "error entered, please enter again", vbInformation, "Kutools for Excel"
GoTo LInput
Else
xScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
For I = 1 To xCount
ActiveSheet.Range("X1").Value = " " & I * 2 - 1
ActiveSheet.PrintOut Copies:=1
Next
ActiveSheet.Range("X1").ClearContents
Application.ScreenUpdating = xScreen
End If
End Sub
 
If (xCount = "0") Or (Not IsNumeric(xCount)) Or (xCount < 1) Then

satırını değiştirin.
 
Rica ederim. Güle güle kullanın.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst