Excel'de seçili alanı PDF ile yazdırmak

akinkaraman · 29 Aralık 2014

Bendeki kod tüm sayfaları pdf'e çeviriyor. Ben sadece seçili alanı pdf'e çevirmesini ve bunu yaparken yatay mı düşey mi olacağını sormasını ve pdf'e ad verebilmeyi istiyorum.

Yardımcı olabilir misiniz?

Kod:

Sub Save_as_pdf()
Dim FSO As Object
Dim s(1) As String
Dim sNewFilePath As String

Set FSO = CreateObject("Scripting.FileSystemObject")
s(0) = ThisWorkbook.FullName

If FSO.FileExists(s(0)) Then
'//Change Excel Extension to PDF extension in FilePath
s(1) = FSO.GetExtensionName(s(0))
If s(1) <> "" Then
s(1) = "." & s(1)
sNewFilePath = Replace(s(0), s(1), ".pdf")

'//Export to PDF with new File Path
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=sNewFilePath, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
End If
Else
'//Error: file path not found
MsgBox "Error: this workbook may be unsaved. Please save and try again."
End If

Set FSO = Nothing

End Sub

Korhan Ayhan · 29 Aralık 2014

Merhaba,

Aşağıdaki kodu deneyiniz.

Kod:

Sub SEÇİLEN_ALANI_PDF_KAYDET()
    Dim Dosya_Adi As Variant, Yol As String, Eski_Sayfa_Yonu As Byte
    Dim Onay_Dikey As Byte, Onay_Yatay As Byte
    
    Yol = ThisWorkbook.Path & "\"
    
    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
    
    Dosya_Adi = Yol & Dosya_Adi & ".pdf"
    
    Eski_Sayfa_Yonu = ActiveSheet.PageSetup.Orientation
    
    If Eski_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
            ActiveSheet.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
            ActiveSheet.PageSetup.Orientation = 1
        End If
    End If
    
    Selection.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Dosya_Adi, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, OpenAfterPublish:=True

    ActiveSheet.PageSetup.Orientation = Eski_Sayfa_Yonu

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

akinkaraman · 29 Aralık 2014

Hocam çok teşekkür ederim.

1 sayfaya sığdırmasını sağlayabilir miyiz? Bir de nereye kaydetmemizi istediğimizi sorsa..

Korhan Ayhan · 29 Aralık 2014

Aşağıdaki kodu deneyiniz.

Kod:

Sub SEÇİLEN_ALANI_PDF_KAYDET()
    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

akinkaraman · 30 Aralık 2014

Mükemmel.. Sorunsuz çalışıyor.. Çok teşekkür ederim hocam..

Ergün GÖKER · 30 Aralık 2014

Pdf

Korhan hocam ekli dosyal konusunda yardımcı olabilirmisiniz ?

Ergün GÖKER · 30 Aralık 2014

pdf hakkında

Korhan hocam ekli dosya konusunda yardımcı olabilirmisiniz ?
Önceki gönderdiğim pdf dosyası iptal bu mesajda gönderdiğim pdf1 eki doğrudur. Özür Diliyorum. Diğer mesajı iptal edemedim. Doğrusu bu mesajdaki ektir. Şimdiden Teşikkürler

akinkaraman · 30 Aralık 2014

Korhan hocam her PDF yapışımdan sonra beni bulunduğum sayfadan, çalıştığım excel dosyasındaki son sayfaya atıyor. Neden acaba?

Korhan Ayhan · 30 Aralık 2014

Merhaba,

Üstteki mesajımdaki koda küçük bir ekleme yaptım. Son halini deneyiniz.

akinkaraman' Alıntı:
Korhan hocam her PDF yapışımdan sonra beni bulunduğum sayfadan, çalıştığım excel dosyasındaki son sayfaya atıyor. Neden acaba?

Korhan Ayhan · 30 Aralık 2014

ergungoker03' Alıntı:
Korhan hocam ekli dosya konusunda yardımcı olabilirmisiniz ?
Önceki gönderdiğim pdf dosyası iptal bu mesajda gönderdiğim pdf1 eki doğrudur. Özür Diliyorum. Diğer mesajı iptal edemedim. Doğrusu bu mesajdaki ektir. Şimdiden Teşikkürler

Merhaba Ergun Bey,

Daha önceki özel mesajımda belirttiğim gibi PDF kaydetme özelliği 2007 ve sonrası için geçerli bir özelliktir.

Bu sebeple size ofis versiyonunuzu değiştirmenizi önermiştim.

Bunun dışında eklenti PDF çevirme programları kullanarak çözümler bulunabilir.

Aşağıdaki linkte bu işlemi yapan bir eklentiden bahsedilmiş.

http://www.excelguru.ca/content.php?161

akinkaraman · 30 Aralık 2014

Korhan Ayhan' Alıntı:
Merhaba,

Üstteki mesajımdaki koda küçük bir ekleme yaptım. Son halini deneyiniz.

Elleriniz dert görmesin. :bravo:

Ergün GÖKER · 30 Aralık 2014

Bilgi için Teşekkürler hocam çalışmaya devam edeceğiz demekki

Korhan Ayhan · 31 Aralık 2014

Özel mesajınızda istediğiniz kodları aşağıdaki gibi düzenledim. Kod aktif sayfayı pdf olarak istediğiniz yere belirttiğiniz şekilde isim vererek kayıt eder.

Benim excel dosyam sadece 4 sayfadan oluşuyor ve basit, arkadaşımın muhasebe dosyası ise oldukça fazla alt sayfalardan oluşuyor ve tek sorun her seferinde her oluşturdukları pdf sayfasına ayrı ayrı ad vermek zorunda kalmaları.
Bana şöyle bir şey sordular; acaba diyorlar Pdf adı otomatik olarak bulunduğu sayfanın adı boşluk saat çıkabilir mi kaydederken.
Örneğin : Sayfanın adı Beylikdüzü Sanayi şubesi ise
Pdf için otomatik gelecek isim :
Beylikdüzü Sanayi şubesi 17:36 gibi..
İsterlerse otomatik çıkan Pdf isminde değişiklik yaparlar. Ben de tam uzman sorusu dedim. Sorarım dedim. Biliyorum ki Excel'de yok yok; kesin bunun da bir yolu vardır ancak benim bunlara cevap verebilmem için daha çok fırın ekmek yemem lazım.

Kod:

Sub AKTİF_SAYFAYI_PDF_KAYDET()
    Dim Dosya_Adi As String, 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 = Yol & ActiveSheet.Name & " " & Format(Date, "ddmmyyyy") & "_" & Format(Time, "hhmm") & ".pdf"
    
    Set K1 = ThisWorkbook
    Set S1 = K1.ActiveSheet
    S1.Copy , K1.Worksheets(K1.Worksheets.Count)
    Set S2 = ActiveSheet
    
    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
        .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

    S2.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

akinkaraman · 2 Ocak 2015

Korhan hocam selamlar..

Bu kod aktif alanı ceviriyor. 2 kodu karşılaştırıp öğrenmeye calıştım. Sonra keşfettim ki
.PrintArea = Selection.Address ekleyince secili alanı kaydediyor. Bize secili alan lazımdı ve mükemmel calisiyor kodlariniz. Tekrardan cok teşekkür ederim. Cok isimizi görecek.

İki kod arasındaki bir fark dikkatimi cekti ve merak ettim.

Dosya_Adi As String ile Dosya_Adi As Variant arasındaki fark nedir?

Korhan Ayhan · 2 Ocak 2015

Size iki farklı kod önermiş oldum. Dilediğiniz gibi düzenleyip kullanabilirsiniz.

Değişken tanımlamaları ile ilgili olarak aşağıdaki linki inceleyiniz. Gerekli açıklamalar linkte mevcut.

Değişkenler

akinkaraman · 2 Ocak 2015

İyi seneler

Tevfik_Kursun · 4 Ocak 2015

Sayın Korhan Hocam,
Son verdiğiniz kodu sadeleştirmek istedim, ama yapamadım. Yardımcı olursanız sevinirim.
Dosyanın bulunduğu yere,
(4, 134) ten isim alarak,
sayfa yatay PageSetup.Orientation = 1
belirtilmiş yazdırma alanını ActiveSheet.PageSetup.PrintArea = "$EC$6:$FX$74"
nasıl kayıt ederim.
Saygılarımla

Tevfik_Kursun · 9 Ocak 2015

Sayın Korhan Hocam,
Bu problemi de çözdüm.
İlginize teşekkür ederim.
Saygılarımla

Excel'de seçili alanı PDF ile yazdırmak

akinkaraman

Korhan Ayhan

Administrator

akinkaraman

Korhan Ayhan

Administrator

akinkaraman

Ergün GÖKER

Ekli dosyalar

Ergün GÖKER

Ekli dosyalar

akinkaraman

Korhan Ayhan

Administrator

Korhan Ayhan

Administrator

akinkaraman

Ergün GÖKER

Korhan Ayhan

Administrator

akinkaraman

Korhan Ayhan

Administrator

akinkaraman

Tevfik_Kursun

Tevfik_Kursun