• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Sayfaları PDF formatında kaydetme

F

figutive

Katılım
20 Haziran 2007
Mesajlar
19
Excel Vers. ve Dili
excel 2007
Merhabalar

Excelde mevcut bir çalışmayı sayfalar halinde farklı PDF dosyası olarak kaydetmek istiyorum. Yazdığım macroyu aşağıda görebilirsiniz. Dosyaları oluşturuyor ancak her dosyada aynı sayfayı kaydediyor. Nerde yanlışlık yaptığım hakkında yardımcı olur musunuz?

Selamlar&Teşekkürler
Kod: 
Sub PDF()
Dim bas As Range
Dim bit As Range
Dim ilk As Integer
Dim son As Integer
Dim a As Integer
Dim say As Integer
Dim sayfaadi As Long


ilk = Sheets("CK").Range("B1").End(xlDown).Row
son = Sheets("CK").Range("A1").SpecialCells(xlCellTypeLastCell).Row
Application.ScreenUpdating = False

For a = ilk To son Step 27

For sayfaadi = 1 To 5

        Set bas = Sheets("CK").Range("B" & a)
        Set bit = Sheets("CK").Range("E" & a + 26)
        ActiveSheet.PageSetup.PrintArea = bas.Address & ":" & bit.Address
        With ActiveSheet.PageSetup
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = 1
        End With
        
        
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Users\190500\Desktop\KG" & sayfaadi & ".pdf" _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False

    say = say + 1

Next sayfaadi

Next a

ActiveSheet.PageSetup.PrintArea = ""
ActiveSheet.PageSetup.Zoom = 100
Application.ScreenUpdating = True
MsgBox "PDF Alma İslemi Tamamlandı." & vbCrLf & say & " Sayfa masa ustune kaydedildi", vbInformation, "Y A Z D I R"
End Sub
 
Merhabalar
Acaba sürekli aynı tip fakat farklı özelliklerde belge mi alıyorsunuz? Misal depo çıkışı,sevk irsaliyesi gibi.. Eğer öyleyse dosyanın kayıt ismini değiştirirseniz sorun ortadan kalkabilir

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\190500\Desktop\KG" & sayfaadi & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False

say = say + 1

Next sayfaadi

Next a
Genişletmek için tıkla ...

Kaydedilecek dosyanın adı şu şekilde olsun mesela ; sayfaadi_tarih.pdf
 
örnek dosyanız olmadığı için alternatif kod buna bakarak kendinize uyarlıyabilirsiniz

Sub PDF_kaydet()
For i = 1 To ActiveWorkbook.Sheets.Count
sayfaadi = Sheets(i).Name ' dosya adı
Range("B27:E53").Select ' Kayıt yapılacak Bölüm
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\190500\Desktop\KG" & sayfaadi, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next
End Sub
Genişletmek için tıkla ...
 
Failimechul' Alıntı:
Merhabalar
Acaba sürekli aynı tip fakat farklı özelliklerde belge mi alıyorsunuz? Misal depo çıkışı,sevk irsaliyesi gibi.. Eğer öyleyse dosyanın kayıt ismini değiştirirseniz sorun ortadan kalkabilir



Kaydedilecek dosyanın adı şu şekilde olsun mesela ; sayfaadi_tarih.pdf
Genişletmek için tıkla ...


Merhabalar

Ben excelde aynı sayfa içinde aynı formatta alt alta sıralı olan sayfaları tek tek pdf ye atmak istiyorum.
 
ActiveSheet.PageSetup.PrintArea = bas.Address & ":" & bit.Address

yukarı koddan sonra aşağıdaki kodu ekleyiniz durumda bir değişiklik olacakmı

Sheets("CK").Range(bas.Address & ":" & bit.Address).Select
 
Söylediğiniz şekilde denedim ancak olmadı. Dosyayı ekte gönderiyorum

Teşekkürler
 

Ekli dosyalar

şimdi iş yerindeyim buradaki pc de ofis2003 kurulu deneme imkanım olmadı bu kod ofis2007 de çalışıyor

bunu denermisiniz.

Sub PDF_kaydet()
say = 0
For i = 1 To 2
say = say + 1
If say = 1 Then
yer = Range("B2:E28").Select
ElseIf say = 2 Then
yer = Range("B33:E59").Select
End If
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\190500\Desktop\KG" & say, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next
End Sub
Genişletmek için tıkla ...

ayrıca kodun ofis2007 de çalışması için aşağıdaki linkdeki eklentiyi yüklemeniz gerekiyor.

http://www.microsoft.com/downloads/d...displayLang=tr
 
uzmanamele' Alıntı:
merhaba

alternatif olarak aşağıdaki linkten de yararlanabilirsiniz.
http://www.excel.web.tr/f48/farkly-kaydetten-pdf-olarak-kaydetme-t88504.html
Genişletmek için tıkla ...

Benim yapmaya çalıştığım işlemle bu linkteki işlem arasında küçük bir fark var ve bunu aşamıyorum.

Benim dosyamdaki sayfada pdf alacağım sayfalar ayarlı olmadığı için öncelikle her sayfayı fit to page 1,1,1, yapmam gerekiyor. Sanırım bunu yaparken 2 tane for ve next kullanırken bir şeyleri yanlış yapıyorum.
 
halit3' Alıntı:
şimdi iş yerindeyim buradaki pc de ofis2003 kurulu deneme imkanım olmadı bu kod ofis2007 de çalışıyor

bunu denermisiniz.



ayrıca kodun ofis2007 de çalışması için aşağıdaki linkdeki eklentiyi yüklemeniz gerekiyor.

http://www.microsoft.com/downloads/d...displayLang=tr
Genişletmek için tıkla ...

Merhabalar

Teşekkürler. Bu kod işe yaradı ancak bu defada sayfaları tek sayfaya sıkıştırmadığı için pdf sayfa formatları bozuk geliyor.

Düzeltme: teşekkürler. Sayfa sorununuda hallettim. Emek veren herkese çok çok teşekkürler.
Ellerinize sağlık
 
Son bir soru daha sormak istiyorum

PDF dosya ismi olarak Excelde yer alan referans numarasını vermek istiyorum. Alınan her sayfada E sutünunda E2, E33, E64....... hücrelerinde Referanslarım var. Bunların aynı zamanda PDF dosya ismi olması mümkün müdür. Çünkü referanslar bir yerden sonra numara değiştiriyor

Yani ilk üç dosya KG 1.1- KG 1.2 - KG 1.3 diye giderken dördüncü dosya KG 2.1 ile başlıyor ve bu şekilde KG 20.9 a kadar gidiyor.
 
merhaba

sorunuza biraz uzak kalmakla beraber syn hali3'ün kodları üzerinden cevap vermeye çalışayım.
Kod: 
Sub PDF_kaydet()
say = 0
For i = 1 To 2
say = say + 1
If say = 1 Then
yer = Range("B2:E28").Select
ElseIf say = 2 Then
yer = Range("B33:E59").Select
End If
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\190500\Desktop\KG" & [COLOR="Red"]say[/COLOR], Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next
End Sub

say yerine [E2] yazabilirsiniz.
 
buda alternatif kod

Sub PDF_kaydet()
For i = 2 To Cells(Rows.Count, "B").End(3).Row
sayfaadi = Cells(2, i).Value
Range("B" & i & ":E" & i + 26).Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\190500\Desktop\KG" & sayfaadi, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
i = i + 31
Next
End Sub
Genişletmek için tıkla ...
 
kodda eksiklik oldu
Sub PDF_kaydet()
For i = 2 To Cells(Rows.Count, "B").End(3).Row
sayfaadi = Cells(i, 2).Value
yer = Range("B" & i & ":E" & i + 26).Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\190500\Desktop\KG" & sayfaadi, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
i = i + 31
Next
End Sub
Genişletmek için tıkla ...
 
halit3' Alıntı:
buda alternatif kod
Genişletmek için tıkla ...

Maalesef yapamadım.

Macro konusunda daha çok yeniyim. Bugün şu ana kadar öğrendiklerimi özümseyeyim. PDF dosyasına exceldeki bir hücrede yer alan ismi verme haricinde makro sorunsuz çalışıyor. Benzer konuda forumu okuyanlara yardımcı olması açısından makronun son halini aşağıya kopyalıyorum

Selamlar
Kod: 
Sub PDF_YAZDIR()
Dim bas As Range
Dim bit As Range
Dim ilk As Integer
Dim son As Integer
Dim a As Integer
Dim say As Integer

ilk = Sheets("CK").Range("B1").End(xlDown).Row
son = Sheets("CK").Range("A1").SpecialCells(xlCellTypeLastCell).Row
Application.ScreenUpdating = False

For a = ilk To son Step 27

        Set bas = Sheets("CK").Range("B" & a)
        Set bit = Sheets("CK").Range("E" & a + 26)
        ActiveSheet.PageSetup.PrintArea = bas.Address & ":" & bit.Address
        With ActiveSheet.PageSetup
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = 1
        End With
      say = say + 1

Next a

say = 0
For i = 1 To 20
say = say + 1
If say = 1 Then
yer = Range("B2:E28").Select
ElseIf say = 2 Then
yer = Range("B33:E59").Select
End If
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\190500\Desktop\calisma_kagidi_pdf\KG" & say, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next


ActiveSheet.PageSetup.PrintArea = ""
ActiveSheet.PageSetup.Zoom = 100
Application.ScreenUpdating = True
MsgBox "PDF Alma İslemi Tamamlandı." & vbCrLf & say & " Sayfa masa ustune kaydedildi", vbInformation, "Y A Z D I R"
End Sub
 
dosya adınıda ekledim eski koda

Sub PDF_kaydet()
say = 0
For i = 1 To 2
say = say + 1
If say = 1 Then
yer = Range("B2:E28").Select
dasyaadi = Range("B2").Value
ElseIf say = 2 Then
yer = Range("B33:E59").Select
dasyaadi = Range("B33").Value
End If
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\190500\Desktop\KG" & dasyaadi, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next
End Sub
Genişletmek için tıkla ...
 
halit3' Alıntı:
dosya adınıda ekledim eski koda
Genişletmek için tıkla ...

Halit bey

Tamamdır dosya bu haliyle sorunsuz çalışıyor. E2-E33..... hücrelerini dosya ismi olarak yazıyor.

Code son hali aşağıdaki gibidir. İhtiyaç duyanlar açısından yeniden yazdım.

Yeniden Çok çok teşekkürler.

Herkesin Emeğine eline sağlık

Kod: 
Sub PDF_YAZDIR55()
Dim bas As Range
Dim bit As Range
Dim ilk As Integer
Dim son As Integer
Dim a As Integer
Dim say As Integer

ilk = Sheets("CK").Range("B1").End(xlDown).Row
son = Sheets("CK").Range("A1").SpecialCells(xlCellTypeLastCell).Row
Application.ScreenUpdating = False

For a = ilk To son Step 27

        Set bas = Sheets("CK").Range("B" & a)
        Set bit = Sheets("CK").Range("E" & a + 26)
        ActiveSheet.PageSetup.PrintArea = bas.Address & ":" & bit.Address
        With ActiveSheet.PageSetup
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = 1
        End With
      say = say + 1

Next a

say = 0
For i = 1 To 5
say = say + 1
If say = 1 Then
yer = Range("B2:E28").Select
dasyaadi = Range("E2").Value
ElseIf say = 2 Then
yer = Range("B33:E59").Select
dasyaadi = Range("E33").Value
End If
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\190500\Desktop\calisma_kagidi_pdf\" & dasyaadi, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next


ActiveSheet.PageSetup.PrintArea = ""
ActiveSheet.PageSetup.Zoom = 100
Application.ScreenUpdating = True
MsgBox "PDF Alma İslemi Tamamlandı." & vbCrLf & say & " Sayfa masa ustune kaydedildi", vbInformation, "Y A Z D I R"
End Sub
 
iyi çalışmalar
 
evet 14 nolu mesajdaki kodu denedinizmi.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst