Soru Koli üstü yazdırma

[clawee]

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

 

[ÖmerBey]

Merhaba,
ActiveSheet.PrintOut satırını Activesheet.PrintOut Copies:=2 şekilde değiştirip deneyiniz.

 

[clawee]

Merhaba,
ActiveSheet.PrintOut satırını Activesheet.PrintOut Copies:=2 şekilde değiştirip deneyiniz.

Merhaba;

Çok teşekkür ederim

 

[ÖmerBey]

Rica ederim,
İyi çalışmalar...

 

[techmert]

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.

 

[clawee]

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

 

[ÖmerBey]

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.

Merhaba,
For I = 1 To xCount satırını For I = 1 To xCount Step 2 şeklinde değiştirip deneyiniz...

 

[clawee]

Merhaba
Denedim ancak sadece 2 baskı veriyor 1 ve 3 devamı gelmiyor.

 

[ÖmerBey]

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.

 

[clawee]

Ömer bey teşekkür ederim bu şekilde tam istediğim gibi oldu.

 

[clawee]

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

 

[reosman]

If (xCount = "0") Or (Not IsNumeric(xCount)) Or (xCount < 1) Then

satırını değiştirin.

 

[clawee]

If (xCount = "0") Or (Not IsNumeric(xCount)) Or (xCount < 1) Then

satırını değiştirin.

Çok teşekkür ederim.

 

[reosman]

Rica ederim. Güle güle kullanın.