Yazdırırken sayfa biriktirme sorunu

[Korhan Ayhan]

Selamlar,

İşiniz bitince sayfaları silerseniz dosya boyutunuz büyümez. Yani bu sayfaları geçici olarak ekleyeceksiniz.

 

[seyhan6591]

evet fikir güzel teşekkür ederim
ama ben hala bu işin sayfa açmadan, kodlarla ve sayfaları biriktirerek yapılabileceğini düşünüyorum ve bu konuda bilgisi olan arkadaşlardan yardım bekliyorum.

 

[Korhan Ayhan]

Selamlar,

Ayrıca dosyanızın boyutunun bu kadar fazla olması gereksiz şekilde satırların işlem görmesinden kaynaklanıyor. Sayfalarda CTRL+END tuşlarına bastığımda 65536. satırlara gelmektedir. İşinize yaramayan boş satır ve sütunları seçip silerseniz dosya boyutunuz düşecektir.

 

[seyhan6591]

Selamlar,

Ayrıca dosyanızın boyutunun bu kadar fazla olması gereksiz şekilde satırların işlem görmesinden kaynaklanıyor. Sayfalarda CTRL+END tuşlarına bastığımda 65536. satırlara gelmektedir. İşinize yaramayan boş satır ve sütunları seçip silerseniz dosya boyutunuz düşecektir.

Evet güzel bilgiydi. Neden bu kadar büyük olduğunu bulamamıştım....
Teşekkürler

 

[seyhan6591]

Sorunum kısmen çözüldü ancak konu başlığıyla uyumlu olarak bir cevap aramaya devam ediyorum...
Sayfaları bellekte biriktirip print edecek VBA komutlarını bilenlere....soruyorum.

 

[seyhan6591]

Selamlar,

İşiniz bitince sayfaları silerseniz dosya boyutunuz büyümez. Yani bu sayfaları geçici olarak ekleyeceksiniz.

Büyük fabrikaların sağlık testlerinin raporları söz konusu. Ortalama sayı 200-300 kişi, ender olarak 2000-3000 kişi olabiliyor ve bunların hepsini tek kalemde çıkarmak gerekiyor. Dolayısıyla işi bitirmek için sayfa sayısı geçici olarak da olsa 2000-3000 olabilecek. Bu sayfa sayısı bilgisayarı yavaşlatmaz mı? Bilgisayarın kilitlenme riski ve sürekli yedekleme zorunluluğu getirmesi de dezavantaj.

 

[seyhan6591]

Böyle bir kod buldum. Alakalı olabilir mi?


Print odd and even pages
This option is not available in Excel but you can use a macro to do it.
Sub Print_Odd_Even()
Dim Totalpages As Long
Dim StartPage As Long
Dim Page As Integer

StartPage = 1 '1 = Odd and 2 = Even

'Or use the InputBox suggestion from Gord Dibben
'StartPage = InputBox("Enter 1 for Odd, 2 for Even")

Totalpages = Application.ExecuteExcel4Macro("GET.DOCUMENT(50)")
For Page = StartPage To Totalpages Step 2
ActiveSheet.PrintOut from:=Page, To:=Page, _
Copies:=1, Collate:=True
Next
End Sub

 

[Korhan Ayhan]

Selamlar,

Önerdiğim yöntemle ilgili aşağıdaki kodu kullanabilirsiniz.

Kodun çalışma mantığı;

VERİ isimli bir sayfamız bulunmaktadır.
İlk olarak bu sayfa dışındaki tüm sayfaları diziye alarak topluca siliyoruz.
VERİ sayfasını 500 defa kopyalıyoruz. Siz kopyalamadan sonra kendi aktarım kodlarını yazmalısınız.
Kopyalanan sayfaları tekrar diziye alıp topluca yazdııyoruz.
Yazdırma işlemi tamamlandıktan sonra yine sayfaları diziye alıp topluca silerek işlemi tamamlıyoruz.

500 kopya için işlem süresi yaklaşık olarak 5 dakikadır.

Option Explicit
 
Sub AKTAR_YAZDIR()
    Dim X As Integer, SAYFALAR() As Variant, SAY As Integer
 
    Application.ScreenUpdating = False
 
    SAY = 0
 
    If Worksheets.Count > 1 Then
        Application.DisplayAlerts = False
 
        For X = 2 To Worksheets.Count
            If Sheets(X).Name <> "VERİ" Then
            ReDim Preserve SAYFALAR(SAY)
            SAYFALAR(SAY) = Sheets(X).Name
            SAY = SAY + 1
            End If
        Next
 
        Sheets(SAYFALAR).Delete
 
        Application.DisplayAlerts = True
    End If
 
    For X = 1 To 500
        Sheets("VERİ").Copy After:=Sheets(Worksheets.Count)
        ActiveSheet.Name = X
    Next
 
    SAY = 0
 
    For X = 2 To Worksheets.Count
        If Sheets(X).Name <> "VERİ" Then
        ReDim Preserve SAYFALAR(SAY)
        SAYFALAR(SAY) = Sheets(X).Name
        SAY = SAY + 1
        End If
    Next
 
    Sheets(SAYFALAR).PrintOut
 
    SAY = 0
 
    If Worksheets.Count > 1 Then
        Application.DisplayAlerts = False
 
        For X = 2 To Worksheets.Count
            If Sheets(X).Name <> "VERİ" Then
            ReDim Preserve SAYFALAR(SAY)
            SAYFALAR(SAY) = Sheets(X).Name
            SAY = SAY + 1
            End If
        Next
 
        Sheets(SAYFALAR).Delete
 
        Application.DisplayAlerts = True
    End If
 
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[seyhan6591]

Bu soruna çözüm aramaya devam ediyorum yok mu bilen ?

 

[seyhan6591]

Korhan Ayhan bey ilginiz için çok teşekkür ederim (geç de olsa). Aslında siz sorunu çözecek yolu gösterdiniz.
Hala başlığa uygun çözüm aramamın sebebi:
1.Dosya hafızada çok fazla yer kaplayınca Excel'in aklının karışması (kilitlenme veya bozulma) riski,
2."Yazdır" kodlarını Excel oluşturarak yazıcıya gönderiyor. Bunlar Excelin değişmez yapı kodlarındamıdır yoksa VBA ile idare edilebilecek özelliklermidir. Ben ikincisinden ümitliyim.

İyi çalışmalar

 

[seyhan6591]

Arkadaşlar ilginiz için çok teşekkür ederim.
Aradığım kodları bulamadım ama sorunun yazıcıda olduğunu buldum.
Kullandığım yazıcı HP1012 ve 1020 idi.

Samsung ile denediğimde raporları hiç duraksamadan çıkardı.

HP bu tarz programlar için uygun değilmiş demek ki....