Çalışma sayfasındaki belirli sayfaları PDF olarak kaydetmek

[rockbaba]

Merhaba arkadaşlar. sayfanın yerleştirdiğim butonlarla, belirli sayfaları pdf olarak kaydetmek istiyorum. Bir çok yer gezdim ama hepsinde aktif sayfa yada seçili hücreleri yazdırabileceğim örnekler mevcut. Ben bir butonla sheet 2 ve sheet 3 ü aynı sayfada, diğer bir butonla sheet 4 ü , diğer bir butonla sheet 5 i, diğer butonlada sheet 2 sheet 3 sheet 4 sheet 5 i aynı sayfada pdf olarak kaydetmek istiyorum. Bu mümkünmüdür ?

İyi çalışmalar dilerim.

 

[halit3]

Sitede bir çok örnek uygulamalar var
aşağıdaki kod da kırmızı yerleri kendinize göre değiştirin.

Sub savePDF()
Dim Yol As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Yol = ThisWorkbook.Path
isim = "Deneme"
say = CreateObject("Scripting.FileSystemObject").getfolder(Yol).Files.Count + 1

'Sheets("Sheet2").PageSetup.PrintArea = "$c$2:$r$1567"
'Sheets("Sheet3").PageSetup.PrintArea = "$b$2:$t$174"

[COLOR="Red"]Sheets(Array("Sheet2", "Sheet3")).Select
'Sheets(Array("Sheet4", "Sheet5")).Select
'Sheets(Array("Sheet2", "Sheet3", "Sheet4", "Sheet5")).Select[/COLOR]
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Yol & "\" & isim & " " & say & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
Application.ScreenUpdating = True
Application.DisplayAlerts = True

MsgBox "işlem tamam"

End Sub

 

[Korhan Ayhan]

Aşağıdaki kodu kullanabilirsiniz.

Mavi bölüme dosyanızın adını yazın.
Kırmızı bölüme kaydetmek istediğiniz sayfa isimlerinizi yazın.

Sub İSTENEN_SAYFALARI_PDF_FORMATINDA_KAYDET()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Yol = ThisWorkbook.Path & "\[COLOR="Blue"]DENEME.pdf[/COLOR]"
    
    [COLOR="Red"]Sheets(Array("Sayfa1", "Sayfa4"))[/COLOR].Copy
    
    ActiveWorkbook.ExportAsFixedFormat _
    Type:=xlTypePDF, Filename:=Yol, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False
    ActiveWorkbook.Close 0

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[rockbaba]

YArdımlarınız için çok teşekkür ederim. çözüldü.