Excel Sayfalarını Makro ile PDF olarak dışarı çıkarma

[erdaldurmus]

Merhaba;

Aşağıdaki kod çalışma içerisindeki sayfaları xlsx formatında masaüstüne çıkarmaktadır.
Bu kodu çalışma sayfası içerisindeki sayfaları pdf olarak dışarı çıkaracak şekilde nasıl yapabiliriz.
Pdf dosya adını her sayfanın B6 hücresinden alacak. Masaüstüne değilde masaüstünde PDF adında bir klasör oluşturup içine pdfleri aktaracak şekilde nasıl yapabiliriz.

İlginiz ve yardımlarınız için şimdiden teşekkürler.

Sub SayfaDışarıÇık()

Application.ScreenUpdating = False

For i = 1 To Sheets.Count

Sheets(i).Select
Dosya = CreateObject("Wscript.Shell").SpecialFolders.Item("Desktop") & _
Application.PathSeparator & Sheets(i).Name & Sheets(i).[D4] & ".xlsx"

ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=Dosya
ActiveWorkbook.Close

Next i

Application.ScreenUpdating = True

End Sub

 

[bmutlu966]

Sub SayfaDışarıÇık()

Application.ScreenUpdating = False

For i = 1 To Sheets.Count

Sheets(i).Select
Dosya = CreateObject("Wscript.Shell").SpecialFolders.Item("Desktop") & _
Application.PathSeparator & Sheets(i).Name & Sheets(i).[D4] & ".pdf"

ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=Dosya
ActiveWorkbook.Close

Next i

Application.ScreenUpdating = True

End Sub

 

[erdaldurmus]

Sub SayfaDışarıÇık()

Application.ScreenUpdating = False

For i = 1 To Sheets.Count

Sheets(i).Select
Dosya = CreateObject("Wscript.Shell").SpecialFolders.Item("Desktop") & _
Application.PathSeparator & Sheets(i).Name & Sheets(i).[D4] & ".pdf"

ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=Dosya
ActiveWorkbook.Close

Next i

Application.ScreenUpdating = True

End Sub

Teşekkür ederim.Bunu bende denemiştim ancak istediği tam olarak bu değil. Bu çalışma masaüstüne çıkarılan pdf leri bozuk çıkarıyor. Dosyalar açılmıyor.

 

[askm]

Sub KOD_PDF()
Application.ScreenUpdating = False
On Error Resume Next
yol = Environ("USERPROFILE") & "\Desktop\"
For i = 1 To Sheets.Count
    isim = [b6]

    Sheets(i).Select
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    yol & "/" & isim & ".pdf", _
    Quality:=xlQualityStandard, IncludeDocProperties:=True
Next i
Application.ScreenUpdating = True
End Sub

 

[erdaldurmus]

Sub KOD_PDF()
Application.ScreenUpdating = False
On Error Resume Next
yol = Environ("USERPROFILE") & "\Desktop\"
For i = 1 To Sheets.Count
    isim = [b6]

    Sheets(i).Select
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    yol & "/" & isim & ".pdf", _
    Quality:=xlQualityStandard, IncludeDocProperties:=True
Next i
Application.ScreenUpdating = True
End Sub

Emeğiniz için teşekkür ederim.

 

[askm]

Rica ederim. Kolay gelsin.

 

[cem116]

Sub KOD_PDF()
Application.ScreenUpdating = False
On Error Resume Next
yol = Environ("USERPROFILE") & "\Desktop\"
For i = 1 To Sheets.Count
    isim = [b6]

    Sheets(i).Select
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    yol & "/" & isim & ".pdf", _
    Quality:=xlQualityStandard, IncludeDocProperties:=True
Next i
Application.ScreenUpdating = True
End Sub

iki gündür aradığım şeyi bugün sayenizde buldum Emeğiniz için çok teşekkürler ama benim bundan biraz daha farklı bir şeye ihtiyacım var. Şöyle ki benim dosyamda 25 sayfa var, 1.sayfa ile işim yok, orada çünkü veri girişleri ve yazdır ,kaydet gibi butonlarım var. Ama diğer sayfaları tek tek pdf e dönüştürebileceğim gibi, örneğin 2 ve 3 ü birlikte aynı pdf te, ya da 6-7 yi birlikte aynı pdfte kaydetmeye ihtiyacım var. Bunu yapmamız mümkün mü acaba ? ya da basitçe özetlersek, hangi sayfaları pdf yapmak istediğimizi sorsa ve istediğimiz sayfaları seçerek ister birlikte ister tek tek pdf olarak kaydedebilsek ? şimdiden teşekkürler...

 

[cem116]

Yardımcı olabilecek kimse var mı acaba ?

 

[cem116]

Sub KOD_PDF()
Application.ScreenUpdating = False
On Error Resume Next
yol = Environ("USERPROFILE") & "\Desktop\"
For i = 1 To Sheets.Count
    isim = [b6]

    Sheets(i).Select
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    yol & "/" & isim & ".pdf", _
    Quality:=xlQualityStandard, IncludeDocProperties:=True
Next i
Application.ScreenUpdating = True
End Sub

bu kodu kullanıyorum tek yaptığım şey b6 yerine bende dosya isimleri a2 hücresinde olduğu için o kısmı a2 ile değiştirmek. Her sayfayı ayrı ayrı pdf haline getiriyor. Ancak adlandırma yaparken iş karışıyor. periyodik olarak devam ediyor mu bilmiyorum ama gördüğüm kadarıyla her sayfaya o saydaki a2 hücresindeki ismi değil de, bir önceki sayfada a2 de yazan ismi vererek kaydediyor. Bunu nasıl düzeltebilirim ?

 

[Korhan Ayhan]

Bu satırı;

Sheets(i).Select

Bu satırın altına alıp deneyin.

Sheets(i).Select

 

[cem116]

Bu satırı;

Sheets(i).Select

Bu satırın altına alıp deneyin.

Sheets(i).Select

Çok teşekkür ederim... İlginiz sayesinde hallettik problemi. Yardımlarınız için tekrar tekrar teşekkürler, iyi geceler...