VBA - PDF OLARAK DOSYAYA KAYIT

[sinotto]

Merhaba,

Excel'in ilk sayfasını masaüstünde oluşturmuş olduğum klasörün içerisinde istemiş olduğum isimle kaydetmek istiyorum.
Aşağıda bulunan kod ile istediğim pdf yerine boş klasör kaydediyor. ( Seçmiş olduğum dosyaya klasör olarak kaydediyor. ) Pdf olarak kaydolması için sheet1'in, nasıl bir yol izlemem gerekiyor.

Desteğinizi rica ederim.

Option Explicit
Dim Klasör, Klasöryolu, Buldum, BilgiMesajı, wsÖRNEK As Variant
Dim ÖrnekDosya, YeniDosya, Dosyaxlsm, ad As Variant


Private Sub CommandButton1_Click()
Set Klasör = CreateObject("Scripting.fileSystemObject")
Klasöryolu = ThisWorkbook.Path & "\" & "2022_Masraflar"
Buldum = Klasör.folderexists(Klasöryolu)
If Buldum = True Then
BilgiMesajı = MsgBox("2022_Masraflar" & vbNewLine & "Adlı Klasör Mevcut", vbInformation, "Bilgi Mesajı")
Else
Klasör.createfolder Klasöryolu
BilgiMesajı = MsgBox("2022_Masraflar" & "Klasörü Açılmıştır", vbInformation, "Bilgi Mesajı")

End If
On Error Resume Next
ad = InputBox("Masraf Numarasını ve Firma İsmini giriniz. Örnek: KOZMATİN_00001.")
MkDir Klasöryolu & "\" & ad
BilgiMesajı = MsgBox(ad & " Klasörü Açılmıştır", vbInformation, "Bilgi Mesajı")

'------------------- DOSYA KOPYALAMA

Dim Klasör1 As String, Dosya As String
Dim Masraf_Dosyası As Workbook, Nesne As Object

ad = ThisWorkbook.Path & "\" & "2022_Masraflar" & "\" & ad

If Dir(ad, vbDirectory) = "" Then
MkDir (ad)
End If

Dosya = ad & "\" & Sheets("Masraf_Dosyası").Range("C8").Value & " " & Sheets("Masraf_Dosyası").Range("I8").Value & " " & Sheets("Masraf_Dosyası").Range("I9").Value & ".pdf"

If Dir(Dosya) = "" Then
Application.DisplayAlerts = False
Sheets("Masraf_Dosyası").Copy
Set Masraf_Dosyası = ActiveWorkbook
Masraf_Dosyası.Sheets(1).Name = Sheets("Masraf_Dosyası").Range("I9").Value & ".pdf"

For Each Nesne In ActiveSheet.OLEObjects
If Nesne.progID = "Forms.CommandButton.1" Then
Nesne.Delete
End If
Next

Masraf_Dosyası.SaveAs Dosya
Masraf_Dosyası.Close

MsgBox "Masraf kayıt edilmiştir.", vbInformation
Else
MsgBox "Bu masraf dosyası daha önce kayıt edilmiştir.", vbCritical
End If

End Sub

 

[Korhan Ayhan]

Merhaba,

Linkteki bağlantıları inceleyiniz.

Sorgu için arama sonuçları: ExportAsFixedFormat

www.excel.web.tr

 

[sinotto]

Merhaba,

Linkteki bağlantıları inceleyiniz.

Sorgu için arama sonuçları: ExportAsFixedFormat

www.excel.web.tr

Merhaba,

Yapamadığım için destek rica ediyorum.

 

[Korhan Ayhan]

Bu tarz kodları elde edebilmek için MAKRO KAYDET yöntemini kullanmanızı tavsiye ederim.

Deneyiniz. Dosya adını ve yolunu kendinize göre düzenlersiniz.

Option Explicit

Sub Sheets_To_PDF()
    Dim File_Path As String, File_Name As String

    File_Path = "C:\Users\Desktop\"
    File_Name = InputBox("Dosya adını giriniz...")

    If File_Name = "" Then
        MsgBox "İşleme devam edebilmeniz için dosya adını girmelisiniz!", vbCritical
        Exit Sub
    End If
   
    Sheets(1).ExportAsFixedFormat Type:=xlTypePDF, _
              Filename:=File_Path & File_Name & ".pdf", _
              Quality:=xlQualityStandard, _
              IncludeDocProperties:=True, _
              IgnorePrintAreas:=False, _
              OpenAfterPublish:=False

    MsgBox "PDF dosyası oluşturuldu...", vbInformation
End Sub

 

[sinotto]

Bu tarz kodları elde edebilmek için MAKRO KAYDET yöntemini kullanmanızı tavsiye ederim.

Deneyiniz. Dosya adını ve yolunu kendinize göre düzenlersiniz.

Option Explicit

Sub Sheets_To_PDF()
    Dim File_Path As String, File_Name As String
   
    File_Path = "C:\Users\Desktop\"
    File_Name = "Deneme.pdf"
   
    Sheets(1).ExportAsFixedFormat Type:=xlTypePDF, _
              Filename:=File_Path & File_Name, _
              Quality:=xlQualityStandard, _
              IncludeDocProperties:=True, _
              IgnorePrintAreas:=False, _
              OpenAfterPublish:=False
    MsgBox "PDF dosyası oluşturuldu...", vbInformation
End Sub

Korhan Bey,
İlginiz için teşekkür ederim. Textbox olarak yazabileceğim (Excel içerisinde) PDF ismini oluşturup belirttiğim dosyaya kaydetmesini sağlayamıyorum bir türlü.

 

[Korhan Ayhan]

Önerdiğim koda küçük bir ekleme yaptım. Tekrar deneyiniz.

 

[sinotto]

Önerdiğim koda küçük bir ekleme yaptım. Tekrar deneyiniz.

Çok teşekkür ederim.