Tek Sayfa PDF Oluşturma

ikayserili · 15 Ara 2020

Merhaba
1ci sayfa hariç tüm çalışma kitabını makro ile Tek PDF yaptırmak istiyorum. Yardımcı olabilirmisiniz lütfen.
---
Aşağıdaki kod ile her sayfayı ayrı ayrı PDF'e çevirebiliyorum. Bunları birleştirmesini istiyorum.

Kod:

Bu kodu görmek için giriş yapmanız gerekmektedir (18 satır). Giriş Yap

cakarem · 15 Ara 2020

Örnek dosya ekleyiniz.
Tek pdf olabilmesi için tüm sayfaları tek bir sayfaya aktarıp ardından pdf formatında kaydetmeniz yeterli olacaktır.

Ömer BARAN · 15 Ara 2020

Aşağıdaki konu sayfasında 12 numaralı cevap ekindeki belgedeki userform kodlarında
If CheckBox2 = True Then ...... End If arasında kalan kodları kendi belgenize uyarlamayı deneyin.
İşlem, belirtilen (seçilen) sayfaları TEK PDF olarak kaydetme işlemidir.

https://www.exceldepo.com/konu/listbox-ile-yazdirma-onizleme-pdf-olusturma.3872/

ikayserili · 15 Ara 2020

Ömer Hocam öncelikle ilginiz için teşekkür ederim.
'---------
Dim yol As String, ad As String
ad = "Dosya Adı"
ActiveWorkbook.Sheets.PrintOut
ActiveWorkbook.ExportAsFixedFormat xlTypePDF, yol & "\" & ad & ".pdf"
'-----------
kodu ile bütün sayfaları PDF'e çeviriyor.
Hocam mümkünse 1ci sayfa haricindekileri yaptırabilecek şekilde nasıl düzenleyebiliriz ?
Birinci sayfada veri girişi ekranı var. oranın çıkmaması lazım.

Ömer BARAN · 16 Ara 2020

Şöyle olur.

PDF'ye dahil edilmeyecek sayfanın adını (kodda ikayserili) değiştirin.
PDF adı olarak kullanılan, ÇİFT TIRNAK arasındaki "ExcelDestek" ibaresi yerine PDF belgeye vereceğiniz adı yazın.

Aktif belgenin, kodda adı belirtilen (ikayserili) dışındaki sayfaları TEK PDF olarak, beygeyle aynı dizine kaydedilir.

Kod:

Bu kodu görmek için giriş yapmanız gerekmektedir (24 satır). Giriş Yap

.

ikayserili · 16 Ara 2020

Ömer Hocam
Sheets(isim).Copy
bu kodda hata verdi. bende düzeltebilirmiyim diye bi kaç deneme yaptım. Yaptıklarım;
1) isim adında değişken oluşturdum farklı zamanda 2 adet: Dim isim As Integer veya Dim isim As String
2) isim yazan yerin yerine farklı zamanda 2 adet tanımlama yazdım: "Bilgi Girişi" veya 1
3) If shf.Name <> "Bilgi Girişi" Then yerdeki yere de 1 yazarak deneme yaptım.
1ci denememde hata düzelmedi. 2ci ve 3cü denememde ise 1ci sayfa dahil tüm sayfaları çevirdi.
verdiğiniz kodları şöyle yazdım;
'---------
Set bukitap = ThisWorkbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each shf In ThisWorkbook.Sheets
If shf.Name <> "Bilgi Girişi" Then
XD1 = XD1 + 1
If XD1 = 1 Then
Sheets("Bilgi Girişi").Copy: XD = 1
Else
shf.Copy After:=ActiveWorkbook.Sheets(1)
XD = ActiveWorkbook.Sheets.Count
Sheets(ActiveSheet.Name).Move After:=Sheets(XD)
End If
End If
Next
ActiveWorkbook.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & "Hesaplar" & ".pdf"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
ActiveWorkbook.Close False
MsgBox "İşlem Tamam", vbInformation, "::.. Ömer BARAN ..::"
'-------------

Ömer BARAN · 16 Ara 2020

Sayın @ikayserili .

Bundan önceki kod cevabımı güncelledim.
Sayfayı yenileyerek bir önceki cevabımı tekrar kontrom edin.

.

ikayserili · 16 Ara 2020

teşekkür ederim. sorun çözüldü