2 Kopya yazdırdıktan sonra hücredeki sayının bir artması

[burock1034]

Merhaba ,

yaklaşık 2 saattir uğraşıyorum ve bir türlü kafamı toparlayıpta yapamadım gitti.

İsteğim şu şekilde olacak ,

Ekte bulunan dosyada yurt dışı siparişlerimiz için etiket dökmek istiyorum. Fakat ufak bir engele takıldım.


Örnek şu şekilde anlatayım.
Koli etiketi dökeceğim için koliler uzunlamasına 2 taraflı oluyor yani 1 etiketten 2 adet yazdırmam gerekiyor. B14 Hücresinde bulunan koli numarası 1 olarak düşünürsek 2 adet dökeceğiz ve B14 Hücresine "2" yazacak , 2 kopya dökecek B14 Hücresi "3" yazacak ve bu böyle artacak. Yani Her koli numarasından 2 kopya dökmesi gerekli. ve 166 koli için etiket dökmüş olacağım.

Kodlara bakarsanız eğer ben uzun yoldan yaptım ama bazen dökeceğim koli miktarı değiştikçe teker teker o kodları da değiştirmek zorunda kalıyorum ve çok uzun zamanımı alıyor.

Yardımcı olmanızı rica ediyorum.

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub Yazdir()

    ActiveSheet.PrintOut Copies:=2
    Range("B14") = 1 + Range("B14")

End Sub

.

 

[ExcelF1]

...............

 

[burock1034]

Merhaba,

Bu şekilde deneyin.

Sub Yazdir()

    ActiveSheet.PrintOut Copies:=2
    Range("B14") = 1 + Range("B14")

End Sub

.

Merhaba ,

Saygıdeğer Ömer bey , öncelikle ilginiz için çok teşekkür ediyorum.

Yazdığınız makroyu yaparsak eğer 1den sonsuza kadar değişmiş olmayacak mı?

ben belirlemiş olduğum sayıya kadar kopya dökmesini istiyorum.

Mesela butona tıklanacak , hangi numaraya kadar dökmek istiyorsunuz diye soracak. Örneğin bende 200 yazacağım tamam deyip başlayacak yazdırmaya.

1 numara 2 adet dökecek,
2 numara 2 adet dökecek vs. vs. 200e kadar 2 adet döküp gelecek ve 200 numaraya gelince yazdırma işlemi duracak.

 

[Ömer]

Kod her çalıştığında B14 hücresi 1 den mi başlayacak.

 

[burock1034]

Kod her çalıştığında B14 hücresi 1 den mi başlayacak.

evet 1den başlayacak

 

[Ömer]

Bu şekilde deneyin.

Sub Yazdir()
 
    Dim sor, i
 
    sor = Application.InputBox("Sayı Girin", "Nerede Durayım.")
 
    If sor = "" Or sor = 0 Then Exit Sub
 
    On Error Resume Next
    Range("B14") = 1
 
    For i = 1 To sor
        If Range("B14") > sor Then Exit Sub
        ActiveSheet.PrintOut Copies:=2
        Range("B14") = 1 + Range("B14")
        Application.Wait Now + TimeValue("00:00:01")
    Next i
 
End Sub

.

 

[burock1034]

Bu şekilde deneyin.

Sub Yazdir()
 
    Dim sor, i
 
    sor = Application.InputBox("Sayı Girin", "Nerede Durayım.")
 
    If sor = "" Or sor = 0 Then Exit Sub
 
    On Error Resume Next
    Range("B14") = 1
 
    For i = 1 To sor
        If Range("B14") > sor Then Exit Sub
        ActiveSheet.PrintOut Copies:=2
        Range("B14") = 1 + Range("B14")
        Application.Wait Now + TimeValue("00:00:01")
    Next i
 
End Sub

.

Evettt tamamdır , çok ama çokk teşekkür ediyorum ellerinize sağlık Allah razı olsun