Soru Koli üstü yazdırma

Katılım
2 Şubat 2010
Mesajlar
22
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
 

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,086
Excel Vers. ve Dili
2007 Türkçe
Merhaba,
ActiveSheet.PrintOut satırını Activesheet.PrintOut Copies:=2 şekilde değiştirip deneyiniz.
 

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,086
Excel Vers. ve Dili
2007 Türkçe
Rica ederim,
İyi çalışmalar...
 
Katılım
24 Kasım 2017
Mesajlar
1
Excel Vers. ve Dili
Office 365
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.
 
Katılım
2 Şubat 2010
Mesajlar
22
Excel Vers. ve Dili
2007
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

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,086
Excel Vers. ve Dili
2007 Türkçe
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...
 
Katılım
2 Şubat 2010
Mesajlar
22
Excel Vers. ve Dili
2007
Merhaba
Denedim ancak sadece 2 baskı veriyor 1 ve 3 devamı gelmiyor.
 

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,086
Excel Vers. ve Dili
2007 Türkçe
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.
 
Katılım
2 Şubat 2010
Mesajlar
22
Excel Vers. ve Dili
2007
Ömer bey teşekkür ederim bu şekilde tam istediğim gibi oldu.
 
Katılım
2 Şubat 2010
Mesajlar
22
Excel Vers. ve Dili
2007
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
 
Katılım
26 Nisan 2021
Mesajlar
178
Excel Vers. ve Dili
TR 2021
If (xCount = "0") Or (Not IsNumeric(xCount)) Or (xCount < 1) Then

satırını değiştirin.
 
Katılım
26 Nisan 2021
Mesajlar
178
Excel Vers. ve Dili
TR 2021
Rica ederim. Güle güle kullanın.
 
Üst