Çalışma Sayfasını PDF olarak kayderken excel uzantısını yazmaması

[mars2]

Aşağıodaki makro ile ilgili ayın bulunduğu sayfayı pdf olarak kaydedilmektedir.

' Dosya kaydetme adı
ThisWorkbook = ActiveWorkbook.Name
Thissheet = ActiveSheet.Name
ThisFile = ActiveWorkbook.Name
PathName = ActiveWorkbook.Path
SvAs = PathName & "\" & ThisWorkbook & Thissheet & ".pdf"

SvAs = PathName & "\" & Thissheet & ".pdf" satırına
SvAs = PathName & "\" & ThisWorkbook & Thissheet & ".pdf"

ThisWorkbook eklediğimde çalışma kitabının uzantısı ile kaydetmektedir. Ancak, kaydederken uzantısı olmadan pdf olarak kayıt etmek istiyorum.

Kitap1.xls ocak değil Kitap1 ocak olarak

 

[netzone]

Merhaba,

Paylaştığınız kod için yapay zekadan düzenlemesini istediğimde şu şekilde sonuçlandı, inceleyiniz.

İyi çalışmalar.

Sub AktifSayfayiPDFKaydet()

    Dim ThisWorkbookName As String
    Dim ThisSheetName As String
    Dim PathName As String
    Dim SvAs As String

    ' Excel dosya adı (uzantısız)
    ThisWorkbookName = Replace(ActiveWorkbook.Name, ".xlsx", "")

    ' Aktif sayfa adı
    ThisSheetName = ActiveSheet.Name

    ' Dosya yolu
    PathName = ActiveWorkbook.Path

    ' PDF kaydedilecek tam yol
    SvAs = PathName & "\" & ThisWorkbookName & "_" & ThisSheetName & ".pdf"

    ' PDF olarak kaydet
    ActiveSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=SvAs, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True

    MsgBox "PDF başarıyla oluşturuldu:" & vbCrLf & SvAs, vbInformation

End Sub

 

[mars2]

Sayın netzone;

İlginiz ve yardımınız için teşekkürler.
Kod çalıştı.

 

[Korhan Ayhan]

Önerilen bu satır ThisWorkbookName = Replace(ActiveWorkbook.Name, ".xlsx", "") yerine;

Aşağıdaki satırı kullanırsanız tüm uzantılarda sorunsuz çalışacaktır.

ThisWorkbookName = CreateObject("Scripting.FileSystemObject").GetBaseName(ActiveWorkbook.Name)