VBA PDF Kaydederken Bazı Satırları Atlama

  • Konuyu başlatan Konuyu başlatan merakli
  • Başlangıç tarihi Başlangıç tarihi
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...

merakli

Excel Versiyonu
Excel 2016
Excel Sürümü
64 Bit
Excel Dili
Türkçe
Merhaba,
Örnek dosyada ve resimde gösterildiği gibi listenin altında boş satırları almadan alttaki satırla devam edecek şekilde PDF kaydetmek mümkün müdür?

soru.webp
 
Sayfanın Tümünde Bulunanları ListBox Listeleme
Kapalı Excel Kitabından Veri Alma

Ekli dosyalar

Tarihe göre sırala Oylamaya göre sırala
Merhabalar Sn. @merakli;
Modul1 içerisinde bulunan kodları aşağıdaki kodlar ile değiştirip kullanabilirsiniz.

-- Kod içerisinde bulunan bu kısım, Liste sayfasında B sütununda bulunan hücrelerin satırlarını gizler ve sonradan PDF kaydet kodlarına geçer.
Bu şekilde boş satırlar PDF dosyasına alınmamış olur.
VBA: 
For x = 5 To s1.Range("A" & Rows.Count).End(xlUp).Row - 3
    If s1.Cells(x, "B").Value = "" Then s1.Range("A" & x).EntireRow.Hidden = True
Next x

-- yol = "C:\Users\" & Environ("UserName") & "\Downloads\"
Satırı da oluşturulan PDF dosyanın kayıt edileceği klasör yoludur. Bu satırda İndirilenler (Downloads) klasörüne kayıt aldım, bu satırı çalışmanıza göre değiştiriniz.

VBA: 
Option Explicit
Sub PdfKaydet()
Application.ScreenUpdating = False
Dim pdf_isim As String, yol As String, x As Long, s1 As Worksheet
Set s1 = Sheets("Liste")
pdf_isim = Replace(s1.[A1].Text, "/", " ")
yol = "C:\Users\" & Environ("UserName") & "\Downloads\"

For x = 5 To s1.Range("A" & Rows.Count).End(xlUp).Row - 3
    If s1.Cells(x, "B").Value = "" Then s1.Range("A" & x).EntireRow.Hidden = True
Next x
 
s1.ExportAsFixedFormat Type:=xlTypePDF, Filename:=yol & pdf_isim & ".pdf"

Set s1 = Nothing
pdf_isim = "": yol = "": x = 0
Application.ScreenUpdating = True
End Sub
 
Oyla 0 Olumsuz oyla
Birde şöyle bir durum var
Boş satırlardan bir önceki dolu satır (örneğe göre 52. satır)
ile
Boş satırlardan sonraki dolu satır (örneğe göre 59. satır)
bu satırlar örnekteki gibi sabit değil bu çizelgeden onlarca var ve her çizelgede listedeki isimler ile boş satır sayısı değişken

denedim sanki üstteki döngü burada bahsettiğim işlemi yapıyor gibi :)

dediğiniz gibi satırları gizliyor gibi peki pdf kaydetme işleminden sonra bu satırları yine eski durumuna getirmek için nasıl bir işlem yapmalıyız

VBA: 
For x = 5 To s1.Range("A" & Rows.Count).End(xlUp).Row - 3
    If s1.Cells(x, "B").Value = "" Then s1.Range("A" & x).EntireRow.Hidden = True
Next x

s1.ExportAsFixedFormat Type:=xlTypePDF, Filename:=yol & pdf_isim & ".pdf"

For x = 5 To s1.Range("A" & Rows.Count).End(xlUp).Row - 3
    If s1.Cells(x, "B").Value = "" Then s1.Range("A" & x).EntireRow.Hidden = False
Next x


bu tarz bir şey çözer mi denemeden yazıyorum
 
Oyla 0 Olumsuz oyla
merakli' Alıntı:
Dosyanın kaydedileceği dizini Excel dosyasının bulunduğu dizin olarak ayarlasak ne gibi bir değişiklik yapmalıyız
Genişletmek için tıklayın ...
-- yol isimli değişkeni aşağıdaki satır ile değiştirmeniz yeterlidir.
VBA: 
yol = ThisWorkbook.Path & "\"

merakli' Alıntı:
her çizelgede listedeki isimler ile boş satır sayısı değişken
Genişletmek için tıklayın ...
-- Her listenin yapısı aynı ise yani resimdeki gibiyse.
VBA: 
s1.Range("A" & Rows.Count).End(xlUp).Row [B][COLOR=rgb(132, 53, 52)]- 3[/COLOR][/B]
satırı ile A sütunundaki son dolu satır numarası bulunur.
Örnek listede 61. satır.
-3 ifadesi ile (Ortalama - Net - Yüzde) değerleri sabit olduğu için son dolu satır numarasından bu 3 satırı işleme almaması için çıkartıyoruz.
Yani döngü 5. satır ile 58. satır arasında işlem yapar.
Diğer listelerde de bu şekilde çalışır.

1620156884433.webp

-- Boş hücrelerin tespiti ise, yine her dosyada boş satırlar örnek dosyanızda olduğu gibiyse
VBA: 
If s1.Cells(x, "B").Value = ""
bu satır ile koşul içine alınır ve B sütunundaki boş hücreler gizlenir.
Ama B sütunu dolu diğer hücreler boş ise bu satırlar gizlenmez.

merakli' Alıntı:
pdf kaydetme işleminden sonra bu satırları yine eski durumuna getirmek için nasıl bir işlem yapmalıyız
Genişletmek için tıklayın ...
VBA: 
s1.ExportAsFixedFormat Type:=xlTypePDF, Filename:=yol & pdf_isim & ".pdf"
satırından sonra
VBA: 
Cells.EntireRow.Hidden = False
satırını ekleyiniz. Bu satır sayfada gizli olan tüm satırları açar.
 
Oyla 0 Olumsuz oyla
Aşağıda kullandığım kodlar var.
Bu kodları @Ömer BARAN bey oluşturmuştu
Bu kodlar içerisine onu adapte etmeye çalıştım ama çorba oldu :(

VBA: 
Sub PdfKaydet()
Dim bukitap As Workbook
Set bukitap = ThisWorkbook
Dim yol As String, isim As String, XD1 As Integer, XD As Variant
yol = bukitap.Path: XD1 = 0: isim = Replace(Sheets("Liste").[A1].Text, "/", " ")

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

For Each XD In bukitap.Sheets
    If XD.Name <> "Veri" And XD.Name <> "Liste" And XD.Name <> "Ortalama" And XD.Name <> "Data" Then
        XD1 = XD1 + 1
        If XD1 = 1 Then
            XD = 1: bukitap.Sheets(XD).Copy
        Else
            bukitap.Sheets(XD.Name).Copy After:=ActiveWorkbook.Sheets(1)
            XD = ActiveWorkbook.Sheets.Count
            Sheets(ActiveSheet.Name).Move After:=Sheets(XD)
        End If
    End If
Next
ActiveWorkbook.Worksheets.Select
ActiveWorkbook.Sheets(1).ExportAsFixedFormat xlTypePDF, yol & "\" & isim & ".pdf"

ActiveWorkbook.Close False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic

MsgBox "PDF oluşturulldu" & vbCrLf & vbCrLf & "İşlem Tamamlandı.", vbInformation, "::.. Ömer BARAN ..::"
End Sub
 
Oyla 0 Olumsuz oyla
Eksik paylaşımdan dolayı, yanlış yol aldık.
İsterseniz konu bütünlüğünü korumak için, Asıl kullandığınız kodlar ve dosya ile yeni bir konu açın, sorunuzun cevabı yeni konu üzerinden devam etsin. Bu konuyu da kilitleriz.
 
Oyla 0 Olumsuz oyla
-- İlk mesajdaki örnek dosyanıza göre denedim!

7 numaralı mesajda paylaştığınız kodda bulunan
VBA: 
ActiveWorkbook.Worksheets.Select
satırından sonra aşağıdaki satırları ekleyiniz.
VBA: 
Dim x As Long
For x = 5 To Range("A" & Rows.Count).End(xlUp).Row - 3
    If Cells(x, "B").Value = "" Then Range("A" & x).EntireRow.Hidden = True
Next x
 
Oyla 0 Olumsuz oyla
Örnek dosyayı basit olması açısından seçmiştim. Ancak gerçek dosyaya bunu adapte etmeye çalıştığımda üstteki sorunlarla karşılaştım bundan dolayı şuan kullandığımı belirttiğim kodları paylaşmıştım.
 
Oyla 0 Olumsuz oyla
Sayın @merakli , sınıf sayfaları için 27, Tümü sayfası için 28 sütunluk yapı sabit midir?
Yani NET sayısını gösteren sütunun konumu belli ise, dolu/boş kontrolünün bu sütunda yapılması yerinde olur.

Bu konuyu netleştirdikten sonra;
mevcut PDF oluşturma kodunun aşağıda XXXX yazdığım kısmına, boş/dolu kontrolüne bağlı
birkaç satırlık kod ilavesi yapılarak istediğiniz sonuca ulaşılabilir.

VBA: 
Sheets(ActiveSheet.Name).Move After:=Sheets(XD)
        End If
'XXXXXXX
    End If


.
 
Oyla 0 Olumsuz oyla
O zaman mevcut PDF kayıt makrosunda,
bir önceki cevabımda XXX diye işaretlediğim kısma aşağıdaki satırları eklemeniz yeterli olur gibi görünüyor.

VBA: 
sonsut = 27
        If ActiveSheet.Name = "Tüm" Then sonsut = 28
        For XDs = ActiveSheet.Cells(Rows.Count, sonsut).End(3).Row To 9 Step -1
            If ActiveSheet.Cells(XDs, sonsut).Value = "" Then ActiveSheet.Rows(XDs).Hidden = True
        Next
 
Oyla 0 Olumsuz oyla
@Ömer BARAN Bey

Diyelim ki 8E sayfasında öğrenci isimlerinin karşısında (D9:W16) hiç veri yok.
Bu durumda o sayfayı (8E) pdf yapılacak sayfaların dışında tutabilir miyiz?

aşağıdaki gibi
If XD.Name <> "Veri" And XD.Name <> "Liste" And XD.Name <> "Ortalama" And XD.Name <> "Data" And XD.Name <> "8E" Then

gibi

SORU.webp
 

Ekli dosyalar

Oyla 0 Olumsuz oyla
Vakit çok geç oldu.
Uygun vakitte bakarım.
Tabi tüm sayfalarda birden bu durum gerçekleşirse PDF hiç oluşturulmayacak demek onu da dikkate alacak şekilde günelleme gerekir (işlemin eksiksiz olması bakımından).
 
Oyla 0 Olumsuz oyla
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Benzer Konular Popüler İçerikler Daha Fazlası
Geri
Üst