I

Çözüldü Tek Sayfa PDF oluşturma

ikayserili

Normal Üye
Excel Versiyonu
Excel 2016
Excel Sürümü
64 Bit
Excel Dili
Türkçe
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.
Dim sh As Worksheet
Set sh = ActiveSheet
Set Ds = CreateObject("Scripting.FileSystemObject")
Yol = ThisWorkbook.Path & "\" & ActiveSheet.Name
isim = sh.Range("B3").Value & " - " & Format(Now, "yyyy-mm-dd-hh-mm")

Application.Dialogs(xlDialogPrint).Show

kontrol = Ds.FolderExists(Yol)
If kontrol <> True Then
Ds.CreateFolder Yol
End If

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Yol _
& "\" & isim & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

ActiveWorkbook.Save
 
Ö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.
 
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.


.
Ö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.
 
Şö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.

CSS:
Görüntülemek için giriş yapmanız gerekmektedir.
(24 satır)

.
 
Ö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 ..::"
'-------------
 
Üst