Hücre değerine göre ilave sayfa numarası verilmiş sayfa yazdırma

[cebelitarık]

Forumun değerli üyeleri hayırlı günler

Ekte sunduğum örnek dosya da açıkça görüleceği üzere

E27 hücresinde verilen değere göre Kapak sayfasına ilave olarak sayfa numaraları takip eden sayfaları yazdırmak istiyorum.

Yani E27 hücresinin değeri 20 ise

Kapak sayfayı yazdırdıktan sonra devamında 20 sayfa daha boş sayfa yazdırılacak ve yazdırılan her sayfanın sağ üst köşesine sayfa numaraları verilecek ön kapak sayfasındaki G 11 hücresindeki rakam her sayfanın başına yeralacak

Başka bir anlatımla E 27 hücresinin değerine göre sayfa numaraları verilmiş sayfa üretilecek

ilgilenecek arkadaşlara şimdiden teşekkür ederim.
Saygılar

 

[cebelitarık]

Problemi tam olarak anlatamadım galiba
Konuya ilgi duyan bir arkadaş yokmu

 

[mehmett]

Sn cebelitarık,

Dosyanız ekte.

Dosyada yazılan kodları aşağıda görebilirsiniz.

Sub yazdır()
Sheets("Sayfa1").PrintOut
For i = 1 To [E25]
[E3] = i
Sheets("Sayfa2").PrintOut
Next
[E3] = ""
End Sub

 

[cebelitarık]

ilave özellik

Sayın Mehmett
İlgin için teşekkür ederim ellerine sağlık
çok güzel olmuş
İzin verirsen bunun üzerine bir ricam daha olacak
1) Devamındaki numaralı sayfaları Sheet2 ye geçmeden Sheet1 in 2. sayfasına alabilirmiyiz.
2) Verilen değere göre son sayfayı yazdırırken sheet 1 sayfa 2 nin ortasında bulunan metni mesala defterimiz 20 sayfa ise 20 numaralı sayfanın içine yazdırabilirmiyiz.

Dosyanın yeni halini ekte sundum.
Saygılar

 

[cebelitarık]

Sayın hocalarım 4. mesajıma bir cevap lütfen

 

[mehmett]

Dosyanız ekte Sn cebelitarık.

Sub yazdır()
ActiveSheet.PageSetup.PrintArea = "$A$9:$H$39"
ActiveSheet.PrintOut
ActiveSheet.PageSetup.PrintArea = "$A$58:$I$95"
For i = 1 To [E25]
[E3] = i
ActiveSheet.PrintOut
Next
[E3] = ""
ActiveSheet.PageSetup.PrintArea = ""
End Sub

 

[cebelitarık]

Sayın mehmett

Üstadım eline sağlık güzel çalışıyor
Ancak 4. mesajımın birinci bölümü olarak problem çözülmüş
2. problem:
2) Verilen değere göre son sayfayı yazdırırken sheet1 sayfa 2 nin ortasında bulunan metni (mesala defterimiz 20 sayfa ise 20 numaralı sayfanın içine) yazdırabilirmiyiz.
Sayfa ortasındaki metin sadece son sayfanın içinde olacak
Yani Önce kapak sayfa, sonra aradaki sadece numaralı sayfalar, en sonda da içinde metin olan son sayfa numaralı son sayfa olacak şeklde düzenlenmesi gerekiyor. hazırladığınız son örnekte ki ellerinize sağlık metin tüm sayfalarda çıkıyor.
Problemin 2. kısmı içinde çözümü talep ediyorum cüretimi mazur görmenizi dilerim.
saygılar

 

[cebelitarık]

Çözüm

Sayın mehmett

Çözümü aşağıda eklediğim dosya şeklinde çözdüm fakat yazdırma işlemi her sayfa için yeniden hesaplandığından yavaş yazılıyor.
Başka bir çözüm öneriniz varsa müteşekkir kalırım.
Saygılar

Sub yazdır()
ActiveSheet.PageSetup.PrintArea = "$A$4:$I$57"
ActiveSheet.PrintOut
ActiveSheet.PageSetup.PrintArea = "$A$58:$I$113"
[E1] = [E25] - 1
For i = 1 To [E1]
[E3] = i
ActiveSheet.PrintOut
Next
[G58] = [F9]
[H58] = [G9]
[I58] = "Sayfa " & Cells(25, 5)
[C74] = Cells(25, 5) & " sayfadan ibaret iş bu defter " & Cells(29, 5) & " yılında kullanılmak üzere hazırlanmıştır."
ActiveSheet.PrintOut
Range("I58").Select
ActiveCell.FormulaR1C1 = "=""Sayfa ""&R[-55]C[-4]"
Range("J58").Select
[E3] = ""
[C74] = ""
[E1] = ""
ActiveSheet.PageSetup.PrintArea = ""
End Sub

 

[mehmett]

Sn cebelitarık,

Aşağıdaki kodları dener misiniz, istediğiniz gibi oluyor mu?

Sub yazdır()
ActiveSheet.PageSetup.PrintArea = "$A$4:$I$57"
ActiveSheet.PrintOut
ActiveSheet.PageSetup.PrintArea = "$A$58:$I$113"
For i = 1 To [E25] - 1
[E3] = i
ActiveSheet.PrintOut
Next
[E3] = [E25]
[C74] = [E25] & " sayfadan ibaret iş bu defter " & [E29] & " yılında kullanılmak üzere hazırlanmıştır."
ActiveSheet.PrintOut
[E3] = ""
[C74] = ""
ActiveSheet.PageSetup.PrintArea = ""
End Sub

Kodları biraz daha sadeleştirdim;

Sub yazdır()
[A4:I57].PrintOut
For i = 1 To [E25] - 1
[E3] = i
[A58:I113].PrintOut
Next
[E3] = [E25]
[C74] = [E25] & " sayfadan ibaret iş bu defter " & [E29] & " yılında kullanılmak üzere hazırlanmıştır."
[A58:I113].PrintOut
[E3] = ""
[C74] = ""
End Sub