makro birleştirme

[abdullahss]

arkadaşlar iki makroyu birleştiremiyorum yardımcı olursanız çok sevinirim
yapmak istedigim 3 sayfanın h11 i 1 artırarak yazdırmak ,yazdırma toplam kopya adetini ben belirlemek istiyorum kopya adeti kaç olursa olsun sayfa 1,2.3 ün h11 i artarak devam edecek
Sub YAZDIR()
Dim X As Long
For X = 1 To Sheets.Count
Sheets(X).PrintOut Copies:=1
Sheets(X).[J11] = Sheets(X).[J11] + 1
Next
MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub
Sub yazdır()
adet = InputBox("Kaç defa yazdırılsın?", "", 1)
Worksheets.PrintOut , , adet
End Sub

 

[Ayhan Ercan]

Merhaba Sn abdullahss

Aşağıdaki kodu deneyiniz...

Sub YAZDIR()
Dim X As Long, adet As Integer
adet = InputBox("Kaç defa yazdırılsın?", "", 1)
    For X = 1 To Sheets.Count
        Sheets(X).[H11] = Sheets(X).[H11] + 1
        Sheets(X).PrintOut Copies:=adet
    Next
MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub

 

[abdullahss]

3 defa yazdır dedim son sayfada h11 sayı atlamadı

 

[Ayhan Ercan]

Tekrar Merhaba Sn abdullahss

3 defa yazdır dedim son sayfada h11 sayı atlamadı

Sanırım sorunuz anlaşılmadı.

Diyelimki 5 adet yazdırmak istiyorsunuz.
h11= 500 olsun

ilk Sayfada h11 500
2.sayfada h11 501
3.sayfada h11 502....
diye her yazdırdığınız sayfanın her kopyasındamı H11 lerin artmasını istiyorsunuz?

 

[abdullahss]

Tekrar Merhaba Sn abdullahss



Sanırım sorunuz anlaşılmadı.

Diyelimki 5 adet yazdırmak istiyorsunuz.
h11= 500 olsun

ilk Sayfada h11 500
2.sayfada h11 501
3.sayfada h11 502....
diye her yazdırdığınız sayfanın her kopyasındamı H11 lerin artmasını istiyorsunuz?

her sayfadan birer kopya aldıktan sonra h11 ler 1 artıp her sayfa tekrar yazılacak belirtilen adete kadar

 

[Ayhan Ercan]

Acaba istediğiniz böyle bişeymi?
Kodları denermisiniz...?

Sub YAZDIR()
Dim adet As Integer, y As Integer, x As Integer
adet = InputBox("Kaç defa yazdırılsın?", "", 1)
For x = 1 To Sheets.Count
y = 1
    Do While y < adet + 1
        Sheets(x).PrintOut copies:=y
        Sheets(x).[H11] = Sheets(x).[H11] + 1
        y = y + 1
    Loop
Next
MsgBox "&#304;&#350;LEM&#304;N&#304;Z TAMAMLANMI&#350;TIR.", vbInformation
End Sub

 

[abdullahss]

ayhan bey ilginiz için çok teşekkür ederim ben formu göndereyim daha iyi olacak

 

[abdullahss]

her sayfadan birer kopya aldıktan sonra h11 ler 1 artıp her sayfa tekrar yazılacak belirtilen( adedi ben belirlemeliyim)adete kadar

 

[Ayhan Ercan]

Tekrar Merhaba Sn abdullahss

Yazışarak pek sorununuzu anlayamıyorum galiba,
Sorununuzu kelime kelime okuyarak anlamaya calıştım.

Umarım bu sefer anlamışımdır.
Aşağıdaki kodları denermisiniz...?

Sub YAZDIR()
Dim adet As Integer, y As Integer, x As Integer, i As Integer
adet = InputBox("Kaç defa yazdırılsın?", "", 1)
y = 1
    Do
        For x = 1 To Sheets.Count
            Sheets(x).PrintOut copies:=y
        Next
        For i = 1 To Sheets.Count
            Sheets(i).[H11] = Sheets(i).[H11] + 1
        Next
        y = y + 1
    Loop While y < adet + 1
MsgBox "&#304;&#350;LEM&#304;N&#304;Z TAMAMLANMI&#350;TIR.", vbInformation
End Sub

 

[abdullahss]

ayhan bey ilginiz için çok teşekkür ederim alınan çıktılar 1-3 kopya 2-6 kopya 3-9 kopya,,,,,,,, yapmaya çalıştıgımız 1-3 kopya 2-3 kopya3-3 kopya,,,,,,,,,,,,
olmalı

 

[Ayhan Ercan]

Deneme-Yanılmaya devam o zaman.....

Ama bu sefer çözüldü sanırım. Buyrun Kodlarınızı... :

Sub YAZDIR()
Dim adet As Integer, y As Integer, x As Integer, i As Integer, 
adet = InputBox("Kaç defa yazdırılsın?", "", 1)
y = 1
    Do
        For x = 1 To Sheets.Count
            Sheets(x).PrintOut Copies:= 1
        Next
        For i = 1 To Sheets.Count
            Sheets(i).[H11] = Sheets(i).[H11] + 1
        Next
        y = y + 1
    Loop While y < adet + 1
MsgBox "&#304;&#350;LEM&#304;N&#304;Z TAMAMLANMI&#350;TIR.", vbInformation
End Sub

 

[abdullahss]

ayhan bey şimdi oldu çok teşekkür ederim

 

[Ayhan Ercan]

ayhan bey şimdi oldu çok teşekkür ederim

Rica ederim.
İyi Çalışmalar.. k::