Boş sayfa sorunu

[muratgunay48]

Arkadaşlar, sayın hocalarım, şöyle bir kod yazdım ama 5000'e kadar boş sayfaları da alıyor. Hatam nerede acaba?
Şimdiden teşekkür ederim.
Saygılarımla.

Sub donusturme()
'Sayfa seç
Worksheets("Tümü").Activate
'Saütunları sil
Columns("A:A").Delete
Columns("H:M").Delete
'Satırları sil
Rows("1:1").Delete
'Satır yüksekliği
'Cells.RowHeight = 15 'Tüm sayfa
Rows("1:1").RowHeight = 30
Rows("2:5000").RowHeight = 15
'Satırları dikey ortala
Cells.VerticalAlignment = xlCenter
'Satırı yatay ortala
Range("A1:G1").HorizontalAlignment = xlCenter
'Satır punto büyüklüğü
Rows("1:1").Font.Size = 14
'Sütun genişlikleri
Columns("A:A").ColumnWidth = 4
Columns("B:B").ColumnWidth = 14
Columns("C:C").ColumnWidth = 13
Columns("D:D").ColumnWidth = 8
Columns("E:E").ColumnWidth = 20
Columns("F:F").ColumnWidth = 50
Columns("G:G").ColumnWidth = 20
'Sütun yatay ortala
Columns("A:A").HorizontalAlignment = xlCenter
Columns("B:B").HorizontalAlignment = xlCenter
Columns("C:C").HorizontalAlignment = xlCenter
Columns("D:D").HorizontalAlignment = xlCenter
'Sütun hücre taşmasın (doldur)
Range("G2:G5000").Select
With Selection
        .HorizontalAlignment = xlFill
        .VerticalAlignment = xlCenter
    End With
'Sayfa yapısı
Dim ws As Worksheet
    Set ws = ActiveSheet
        With ws.PageSetup
        .LeftMargin = Application.CentimetersToPoints(1.5) ' Sol boşluk
        .RightMargin = Application.CentimetersToPoints(1.5) ' Sağ boşluk
        .TopMargin = Application.CentimetersToPoints(2) ' Üst boşluk
        .BottomMargin = Application.CentimetersToPoints(2) ' Alt boşluk
        .HeaderMargin = Application.CentimetersToPoints(0) ' Üstbilgi
        .FooterMargin = Application.CentimetersToPoints(0) ' Altbilgi
        .CenterHorizontally = True ' Yatay ortala
        .CenterVertically = True ' Dikey ortala
        '.Orientation = xlLandscape ' Yatay sayfa (xlPortrait = Dikey)
        .PaperSize = xlPaperA4 ' A4 kağıt boyutu
    End With
'Boş sayfaları sil
Application.DisplayAlerts = False 'Uyarı mesajlarını kapat
For Each ws In Worksheets
    'Sayfada veri olup olmadığını kontrol et
        If Application.WorksheetFunction.CountA(ws.UsedRange) = 0 And ws.UsedRange.Cells.Count = 1 Then
           ws.Delete
        End If
    Next ws
    Application.DisplayAlerts = True 'Uyarı mesajlarını aç
End Sub

 

[muratgunay48]

Sayın hocalarım, lütfen ilgilenin. Bu akşam raporları dönüştürmem lazım. Çok rica ediyorum. İnternette çok aradım başarılı olamadım.

 

[netzone]

Merhaba Murat bey,

Söz konusu sorunuza bakıp sebep sonuç arıyorum ancak sonuca ilişkin bir belirteciniz yok!
5000. satıra kadar biçimlendirmiş ve seçtirmişsiniz..
"5000'e kadar boş sayfaları da alıyor" söyleminiz havada kalıyor.
Sorunuzu sorarken yazdığınız kodları ne yapmak için yazdığınızı ve sonuç olarak aldığınız hatayı belirtip aslında şöyle yapmaya çalışmıştım derseniz daha anlaşılır olacağı kanaatindeyim.

İyi çalışmalar.

 

[muratgunay48]

Merhaba Murat bey,

Söz konusu sorunuza bakıp sebep sonuç arıyorum ancak sonuca ilişkin bir belirteciniz yok!
5000. satıra kadar biçimlendirmiş ve seçtirmişsiniz..
"5000'e kadar boş sayfaları da alıyor" söyleminiz havada kalıyor.
Sorunuzu sorarken yazdığınız kodları ne yapmak için yazdığınızı ve sonuç olarak aldığınız hatayı belirtip aslında şöyle yapmaya çalışmıştım derseniz daha anlaşılır olacağı kanaatindeyim.

İyi çalışmalar.

Hocam siteden rapor alıyoruz. Onu bu şekilde dönüştürüyoruz. İlk raporu aldığımız. Bazen 3000-4000 satır olabiliyor. O yüzden.

 

[netzone]

Murat Bey,

Cevap vermişsiniz teşekkürler de hala 5000 satır yerine ne olmasını bekliyorsunuz bunu izah etmemişsiniz!

Bende görüyorum kodlarınızın; boş olan sayfaları silip Tümü adlı sayfada sabit bir görünüm kazandırmak için yazıldığını, sorun şu ki 5000 satır yerine 2000 satırlık veri varsa ne yapmasını istiyorsunuz?

 

[muratgunay48]

Murat Bey,

Cevap vermişsiniz teşekkürler de hala 5000 satır yerine ne olmasını bekliyorsunuz bunu izah etmemişsiniz!

Bende görüyorum kodlarınızın; boş olan sayfaları silip Tümü adlı sayfada sabit bir görünüm kazandırmak için yazıldığını, sorun şu ki 5000 satır yerine 2000 satırlık veri varsa ne yapmasını istiyorsunuz?

Hocam sonu şöyle bitiyor.

    ChDir "C:\Users\muratgunay48\Desktop"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Users\muratgunay48\Desktop\AAA.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False       
End Sub

Yani PDF olarak kaydedecek. 5000'in amacı, ben o gün kaç satır rapor çıkacak bilemem ki. Mesela 1150 çıktı. Satır-sütun yapılandıracak ve PDF olarak kaydedecek.

 

[netzone]

Hocam sonu şöyle bitiyor.

    ChDir "C:\Users\muratgunay48\Desktop"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Users\muratgunay48\Desktop\AAA.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False      
End Sub

Yani PDF olarak kaydedecek. 5000'in amacı, ben o gün kaç satır rapor çıkacak bilemem ki. Mesela 1150 çıktı. Satır-sütun yapılandıracak ve PDF olarak kaydedecek.

Yukarıda paylaşmış olduğunuz kodun içerisinde böyle bir alan yer almamakla birlikte sorunuzun cevabına gelecek olursak;
Biçimlendirme yapmış olduğunuz alanlar her ne kadar içi boş olsa da çıktınızda yer alır, bunun için biçimlendirmeyi son dolu hücreyi tespit ettirip o alana biçimlendirme uygulamanız gerekmektedir.

İyi çalışmalar.