İlgili sekmeyi pdf olarak kaydetmek

[td877]

Merhaba,

İlgili sekmenin O2:AC40 satır ve sütunu kadar bir bölümünü, ismi sekme adı olacak şekilde excel dosyasının olduğu klasöre pdf olarak kaydedecek bir makro yapılabilir mi?

Saygılar

 

[Mahmut Bayram]

Sub pdf_save()
ActiveSheet.PageSetup.PrintArea = "O2:AC40"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "D:\" & ActiveSheet.Name & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False
        MsgBox "işlem tamam"
End Sub

veya

Option Explicit

Sub PDFActiveSheetNoPrompt()
'aynı dosya varsa üzerine yazar
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet

'kaydedilmişse etkin çalışma kitabı klasörünü al
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

strName = wsA.Name

'dosya kaydetmek için varsayılan ad oluştur
strFile = strName & ".pdf"
strPathFile = strPath & strFile

ActiveSheet.PageSetup.PrintArea = "O2:AC40"
'PDF'yi geçerli klasöre dışa aktar
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=strPathFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    'dosya bilgisi ile onay mesajı
    MsgBox "PDF dosyası oluşturuldu: " _
      & vbCrLf _
      & strPathFile

exitHandler:
    Exit Sub
errHandler:
    MsgBox "PDF dosyası oluşturulamadı"
    Resume exitHandler
End Sub

 

[YUSUF44]

Aşağıdaki makroyu deneyiniz. Aynı isimli dosya varsa silinir, son hali kaydedilir:

Sub pdfyap()
    yol = ThisWorkbook.Path & "\"
    Range("O2:AC40").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        yol & ActiveSheet.Name & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End Sub

 

[td877]

Sayın YUSUF44 ve Mahmut Bayram arkadaşlarım ikinize de çok teşekkür ederim makrolar çalışıyor.

Hayırlı işler dilerim.