PDF'leri sırasıyla kaydetmek istiyorum olmuyor

[suatucar]

Merhaba arkadaşlar excelde pdf olarak sayfalarımı sıraya göre kaydetmek istiyorum ama yapamadım yardımcı olabilecek arkaşlardan destegini rica ediyorum.Aşağıdaki kod sadece 1 olarak kaydediyor ve diğer kaydettiklerimin üzerine yazıyor.


Sub Pdf_kaydet()
'
' Pdf_kaydet Makro
'

'
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\suat\Desktop\1.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
Range("G2").Select
End Sub

 

[suatucar]

Yardım edecek yokmu ?

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub Pdf_Kaydet()

    Dim i As Integer, yol As String, s As Integer
    
    yol = CreateObject("Wscript.Shell").SpecialFolders.Item("Desktop")
    
    Application.ScreenUpdating = False
    
    For i = 1 To Worksheets.Count
        If ActiveSheet.PageSetup.PrintArea <> "" Then
            s = s + 1
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                yol & "\" & s & ".pdf", Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, IgnorePrintAreas:=False
        End If
    Next i
    
    Application.ScreenUpdating = True
        
End Sub

.

 

[suatucar]

Hocam ilk önce konuyla ilgili geri dönüş yatıgın için teşekür ederim.
Kodu uyguladım fakat benim istediğim Kaydet butonuna her bastığımda 1.pdf sonrasında
yeniden kaydet butonuna bastıgımda 2.pdf gibi sıraya koyarak ayrı ayrı kaydetmesi.

 

[leumruk]

Selamlar,
Ömer Bey'in müsaadesiyle Ömer Bey'in kodlarını aşağıdaki şekilde revize edersek isteğiniz olacaktır. Değeri a1 hücresinden alıyor. Siz ihtiyacınıza göre farklı alternatifler oluşturabilirsiniz.

Sub Pdf_kaydet()
Dim i As Integer, yol As String, s As Integer
s = [a1]
If s = 0 Or IsNumeric(s) = False Then
s = 1
Else
s = s + 1
End If
yol = CreateObject("Wscript.Shell").SpecialFolders.Item("Desktop")
yol = yol & "\" & s & ".pdf"
Sheets(s).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
yol, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
[a1] = s
End Sub

 

[suatucar]

leumruk verdiginiz kodu yaptım ama "run-time '9': subscript out of range" hatası çıkıyor.

 

[leumruk]

Kodun başındaki tanımı aşağıdaki ile değiştirin:

Dim i As Integer, yol As String, s As Variant

 

[suatucar]

Yardımlarınız için tşk ederim.