• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Boş sayfa sorunu

muratgunay48

muratgunay48

Altın Üye
Katılım
10 Şubat 2010
Mesajlar
1,477
Excel Vers. ve Dili
Office 365 - Türkçe (64 bit)
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.
Kod: 
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
 
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.
 
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.
 
netzone' Alıntı:
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.
Genişletmek için tıkla ...
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.
 
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?
 
netzone' Alıntı:
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?
Genişletmek için tıkla ...
Hocam sonu şöyle bitiyor.
Kod: 
    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.
 
muratgunay48' Alıntı:
Hocam sonu şöyle bitiyor.
Kod: 
    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.
Genişletmek için tıkla ...
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.
 
Sayın hocalarım
'Sütun hücre taşmasın (doldur)
Range("G2:G5000").Select
With Selection
.HorizontalAlignment = xlFill
.VerticalAlignment = xlCenter
End With

Bundan oluyor sanırım. Ama hücreden taşmaması lazım. Nasıl yapacağım.
 
Dosyanızın yedeğini alıp aşağıdaki kodları deneyiniz. *Kodlar yapay zeka tarafından yazıldı.

İyi çalışmalar.

C++: 
Sub donusturme_Guncel()
    Dim ws As Worksheet
    Dim sonSatir As Long
   
    'Sayfa seç
    Set ws = Worksheets("Tümü")
    ws.Activate
   
    '--- 1. SON SATIRI BUL ---
    'B sütununa bakarak en son dolu satırı bulur (B sütunu genelde doludur diye seçtik)
    sonSatir = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
   
    'Eğer veri yoksa işlemi durdur (Başlık hariç veri yoksa)
    If sonSatir < 2 Then sonSatir = 2

    'Sütunları sil
    ws.Columns("A:A").Delete
    ws.Columns("H:M").Delete
   
    'Satırları sil
    ws.Rows("1:1").Delete
   
    'Yeniden son satırı hesapla (Silme işleminden sonra değişmiş olabilir)
    sonSatir = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

    '--- 2. DİNAMİK BİÇİMLENDİRME ---
    ws.Rows("1:1").RowHeight = 30
    'Sadece dolu olan satırların yüksekliğini ayarla
    ws.Rows("2:" & sonSatir).RowHeight = 15
   
    ws.Cells.VerticalAlignment = xlCenter
    ws.Range("A1:G1").HorizontalAlignment = xlCenter
    ws.Rows("1:1").Font.Size = 14
   
    'Sütun genişlikleri
    ws.Columns("A:A").ColumnWidth = 4
    ws.Columns("B:B").ColumnWidth = 14
    ws.Columns("C:C").ColumnWidth = 13
    ws.Columns("D:D").ColumnWidth = 8
    ws.Columns("E:E").ColumnWidth = 20
    ws.Columns("F:F").ColumnWidth = 50
    ws.Columns("G:G").ColumnWidth = 20
   
    'Hizalamalar
    ws.Range("A:D").HorizontalAlignment = xlCenter
   
    'Hücre taşmasını önle (Sadece dolu olan G hücreleri için)
    With ws.Range("G2:G" & sonSatir)
        .HorizontalAlignment = xlFill
        .VerticalAlignment = xlCenter
    End With

    '--- 3. SAYFA YAPISI ---
    With ws.PageSetup
        .PrintArea = "A1:G" & sonSatir 'Yazdırılacak alanı SADECE dolu satırlarla sınırla
        .LeftMargin = Application.CentimetersToPoints(1.5)
        .RightMargin = Application.CentimetersToPoints(1.5)
        .TopMargin = Application.CentimetersToPoints(2)
        .BottomMargin = Application.CentimetersToPoints(2)
        .CenterHorizontally = True
        .PaperSize = xlPaperA4
    End With

    '--- 4. BOŞ SAYFALARI SİL ---
    Application.DisplayAlerts = False
    For Each ws In Worksheets
        If Application.WorksheetFunction.CountA(ws.UsedRange) = 0 Then
           ws.Delete
        End If
    Next ws
    Application.DisplayAlerts = True

    MsgBox "İşlem başarıyla tamamlandı. Yazdırma alanı " & sonSatir & ". satıra kadar sınırlandı.", vbInformation
End Sub
 
netzone' Alıntı:
Dosyanızın yedeğini alıp aşağıdaki kodları deneyiniz. *Kodlar yapay zeka tarafından yazıldı.

İyi çalışmalar.

C++: 
Sub donusturme_Guncel()
    Dim ws As Worksheet
    Dim sonSatir As Long
  
    'Sayfa seç
    Set ws = Worksheets("Tümü")
    ws.Activate
  
    '--- 1. SON SATIRI BUL ---
    'B sütununa bakarak en son dolu satırı bulur (B sütunu genelde doludur diye seçtik)
    sonSatir = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
  
    'Eğer veri yoksa işlemi durdur (Başlık hariç veri yoksa)
    If sonSatir < 2 Then sonSatir = 2

    'Sütunları sil
    ws.Columns("A:A").Delete
    ws.Columns("H:M").Delete
  
    'Satırları sil
    ws.Rows("1:1").Delete
  
    'Yeniden son satırı hesapla (Silme işleminden sonra değişmiş olabilir)
    sonSatir = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

    '--- 2. DİNAMİK BİÇİMLENDİRME ---
    ws.Rows("1:1").RowHeight = 30
    'Sadece dolu olan satırların yüksekliğini ayarla
    ws.Rows("2:" & sonSatir).RowHeight = 15
  
    ws.Cells.VerticalAlignment = xlCenter
    ws.Range("A1:G1").HorizontalAlignment = xlCenter
    ws.Rows("1:1").Font.Size = 14
  
    'Sütun genişlikleri
    ws.Columns("A:A").ColumnWidth = 4
    ws.Columns("B:B").ColumnWidth = 14
    ws.Columns("C:C").ColumnWidth = 13
    ws.Columns("D:D").ColumnWidth = 8
    ws.Columns("E:E").ColumnWidth = 20
    ws.Columns("F:F").ColumnWidth = 50
    ws.Columns("G:G").ColumnWidth = 20
  
    'Hizalamalar
    ws.Range("A:D").HorizontalAlignment = xlCenter
  
    'Hücre taşmasını önle (Sadece dolu olan G hücreleri için)
    With ws.Range("G2:G" & sonSatir)
        .HorizontalAlignment = xlFill
        .VerticalAlignment = xlCenter
    End With

    '--- 3. SAYFA YAPISI ---
    With ws.PageSetup
        .PrintArea = "A1:G" & sonSatir 'Yazdırılacak alanı SADECE dolu satırlarla sınırla
        .LeftMargin = Application.CentimetersToPoints(1.5)
        .RightMargin = Application.CentimetersToPoints(1.5)
        .TopMargin = Application.CentimetersToPoints(2)
        .BottomMargin = Application.CentimetersToPoints(2)
        .CenterHorizontally = True
        .PaperSize = xlPaperA4
    End With

    '--- 4. BOŞ SAYFALARI SİL ---
    Application.DisplayAlerts = False
    For Each ws In Worksheets
        If Application.WorksheetFunction.CountA(ws.UsedRange) = 0 Then
           ws.Delete
        End If
    Next ws
    Application.DisplayAlerts = True

    MsgBox "İşlem başarıyla tamamlandı. Yazdırma alanı " & sonSatir & ". satıra kadar sınırlandı.", vbInformation
End Sub
Genişletmek için tıkla ...



Hocam öncelikle teşekkür ederim.
Sanırım sorun burada
Range("G2:G5000").Select
With Selection
.HorizontalAlignment = xlFill
.VerticalAlignment = xlCenter
End With
Çünkü bu olmazsa düzeliyor. Ama olması lazım. Hücreden taşıyor.
Şöyle bir şey nasıl yazabilirim.

Range("G2:G son dolu hücre").Select
With Selection
.HorizontalAlignment = xlFill
.VerticalAlignment = xlCenter
End With
 
Sayın hocalarım
Sanırım sorun burada
Range("G2:G5000").Select
With Selection
.HorizontalAlignment = xlFill
.VerticalAlignment = xlCenter
End With

Çünkü bu olmazsa düzeliyor. Ama olması lazım. Hücreden taşıyor.
Şöyle bir şey nasıl yazabilirim?

Range("G2:G son dolu hücre").Select
With Selection
.HorizontalAlignment = xlFill
.VerticalAlignment = xlCenter
End With

Şimdiden teşekkür ederim.
Saygılarımla.
 
Murat Bey,

Yukarıdaki kodlar arasında; Son satırı bulma, Hücre taşmasını önleme açıklaması altında talep ettiğiniz kodlar zaten mevcut. Denediniz olmadı mı?
 
netzone' Alıntı:
Murat Bey,

Yukarıdaki kodlar arasında; Son satırı bulma, Hücre taşmasını önleme açıklaması altında talep ettiğiniz kodlar zaten mevcut. Denediniz olmadı mı?
Genişletmek için tıkla ...
Olmadı hocam. Olmadı derken, sadece o kısmı alıyorum, o satırda hata veriyor.
 
Kod: 
Sub donus()

    Dim ws As Worksheet
    Dim sonSatir As Long
    Dim sonSutun As Long
    Dim sonHucre As Range

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set ws = Worksheets("Tümü")
    ws.Activate
    
    ws.Columns("A:A").Delete
    ws.Columns("H:M").Delete
    
    ws.Rows("1:1").Delete
    
    Set sonHucre = ws.Cells.Find(What:="*", _
                                 After:=ws.Range("A1"), _
                                 LookIn:=xlFormulas, _
                                 LookAt:=xlPart, _
                                 SearchOrder:=xlByRows, _
                                 SearchDirection:=xlPrevious, _
                                 MatchCase:=False)

    If sonHucre Is Nothing Then
        MsgBox "Sayfada veri bulunamadı.", vbExclamation
        GoTo Bitir
    End If

    sonSatir = sonHucre.Row
    
    Set sonHucre = ws.Cells.Find(What:="*", _
                                 After:=ws.Range("A1"), _
                                 LookIn:=xlFormulas, _
                                 LookAt:=xlPart, _
                                 SearchOrder:=xlByColumns, _
                                 SearchDirection:=xlPrevious, _
                                 MatchCase:=False)

    sonSutun = sonHucre.Column
    
    If sonSatir < ws.Rows.Count Then
        ws.Rows((sonSatir + 1) & ":" & ws.Rows.Count).Delete
    End If
    
    If sonSutun < ws.Columns.Count Then
        ws.Range(ws.Columns(sonSutun + 1), ws.Columns(ws.Columns.Count)).Delete
    End If
    
    ws.Rows("1:1").RowHeight = 30
    If sonSatir >= 2 Then
        ws.Rows("2:" & sonSatir).RowHeight = 15
    End If
    
    ws.Range(ws.Cells(1, 1), ws.Cells(sonSatir, sonSutun)).VerticalAlignment = xlCenter
    
    ws.Range("A1:G1").HorizontalAlignment = xlCenter
    
    ws.Rows("1:1").Font.Size = 14
    
    ws.Columns("A:A").ColumnWidth = 4
    ws.Columns("B:B").ColumnWidth = 14
    ws.Columns("C:C").ColumnWidth = 13
    ws.Columns("D:D").ColumnWidth = 8
    ws.Columns("E:E").ColumnWidth = 20
    ws.Columns("F:F").ColumnWidth = 50
    ws.Columns("G:G").ColumnWidth = 20
    
    ws.Columns("A:A").HorizontalAlignment = xlCenter
    ws.Columns("B:B").HorizontalAlignment = xlCenter
    ws.Columns("C:C").HorizontalAlignment = xlCenter
    ws.Columns("D:D").HorizontalAlignment = xlCenter
    
    ws.PageSetup.PrintArea = ws.Range(ws.Cells(1, 1), ws.Cells(sonSatir, sonSutun)).Address
    
    ws.ResetAllPageBreaks
    
    With ws.PageSetup
        .LeftMargin = Application.CentimetersToPoints(1)
        .RightMargin = Application.CentimetersToPoints(1)
        .TopMargin = Application.CentimetersToPoints(1)
        .BottomMargin = Application.CentimetersToPoints(1)
        .HeaderMargin = 0
        .FooterMargin = 0
        .CenterHorizontally = True
        .CenterVertically = False
        '.Orientation = xlLandscape
        .PaperSize = xlPaperA4
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
    End With

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

    ws.Range("A1").Select

Bitir:
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

deneyiniz
 
muratgunay48' Alıntı:
Olmadı hocam. Olmadı derken, sadece o kısmı alıyorum, o satırda hata veriyor.
Genişletmek için tıkla ...
Sadece O kısmı alıyorum derken?

Aldıktan sonra kullandığınız kodun tamamını paylaşırmısınız.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst