Seçili Aralığı PDF Olarak Kaydetme

Sub PDFKaydet()
    Dim Dosya_Adi As Variant, Yol As String, Sayfa_Yonu As Byte
    Dim Onay_Dikey As Byte, Onay_Yatay As Byte, Kayit_Yeri As Object
    Dim K1 As Workbook, S1 As Worksheet, S2 As Worksheet
   
    Set Kayit_Yeri = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen dosyanızı kayıt etmek istediğiniz bölümü seçiniz !", 1)
    If Not Kayit_Yeri Is Nothing Then
  Yol = Kayit_Yeri.Self.Path & ""
    Else
  MsgBox "Kayıt etmek istediğiniz bölümü seçmediğiniz için işleminiz iptal edilmiştir.", vbExclamation
  Exit Sub
    End If
   
    Dosya_Adi = InputBox("Lütfen dosya adını giriniz!", "Dosya Adı")
    If Dosya_Adi = "" Then
  MsgBox "Dosya adı girmediğiniz için işleminiz iptal edilmiştir."
  Exit Sub
    End If
   
    Set K1 = ThisWorkbook
    Set S1 = K1.ActiveSheet
    S1.Copy , K1.Worksheets(K1.Worksheets.Count)
    Set S2 = ActiveSheet
   
    Dosya_Adi = Yol & Dosya_Adi & ".pdf"
   
    Sayfa_Yonu = S2.PageSetup.Orientation
   
    If Sayfa_Yonu = 1 Then
  Onay_Dikey = MsgBox("Sayfa yönü dikey olarak ayarlıdır. Değiştirmek istiyorsanız evet seçeneğini tıklayınız.", vbExclamation + vbYesNo)
  If Onay_Dikey = vbYes Then
S2.PageSetup.Orientation = 2
  End If
    Else
  Onay_Yatay = MsgBox("Sayfa yönü yatay olarak ayarlıdır. Değiştirmek istiyorsanız evet seçeneğini tıklayınız.", vbExclamation + vbYesNo)
  If Onay_Yatay = vbYes Then
S2.PageSetup.Orientation = 1
  End If
    End If
   
    With S2.PageSetup
  .PrintArea = Selection.Address
  .LeftMargin = Application.InchesToPoints(0.393700787401575)
  .RightMargin = Application.InchesToPoints(0.393700787401575)
  .TopMargin = Application.InchesToPoints(0.393700787401575)
  .BottomMargin = Application.InchesToPoints(0.393700787401575)
  .HeaderMargin = Application.InchesToPoints(0.393700787401575)
  .FooterMargin = Application.InchesToPoints(0.393700787401575)
  .Zoom = False
  .FitToPagesWide = 1
  .FitToPagesTall = 1
    End With

    Selection.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Dosya_Adi, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, OpenAfterPublish:=True

    Application.DisplayAlerts = False
    S2.Delete
    Application.DisplayAlerts = True

    S1.Select

    Set K1 = Nothing
    Set S1 = Nothing
    Set S2 = Nothing

    MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation
End Sub