• DİKKAT

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

KLASÖR İÇİNDEKİ EXCEL DOSYALARINI TOPLU HALDE PDF'e ÇEVİRMEK

catalinastrap

catalinastrap

Özgür
Destek Ekibi
Katılım
19 Ağustos 2006
Mesajlar
644
Excel Vers. ve Dili
Microsoft® Excel® Microsoft 365 için MSO /64 bit /Türkçe
Merhaba Arkadaşlar;
MASAÜRTÜNDE KAYITLI OLAN KLASÖR İÇİNDEKİ EXCEL DOSYALARINI TOPLU HALDE PDF'e ÇEVİRME MAKROSU ARIYORUM.
 
Merhaba

deneyin

Sub PDFYAP()
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFolder("C:\Users\xxxx\Desktop\Yeni klasör") 'Dosya Yolu yapıştırın
For Each file In f.Files
Set xlWB = Workbooks.Open(file)
thisFileName = Left(xlWB.FullName, InStrRev(xlWB.FullName, ".") - 1)
xlWB.Sheets.Select
xlWB.ActiveSheet.ExportAsFixedFormat 0, thisFileName & ".pdf", 0, 1, 0, , , 0
xlWB.Close False
counter = counter + 1
MsgBox "Dosya " & counter & " of " & f.Files.Count & "Pdf yapıldı"
Next
End Sub
 
Çok teşekkür ederim,
işime yaradı
 
Alternatif kod

Kod: 
Sub pdf_dosyasi_yap()

Set Klasor = CreateObject("shell.application").browseforfolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.SELF.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla

Liste (Kaynak)
Application.ScreenUpdating = True
Application.DisplayAlerts = True

MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
    
End Sub
 
Private Sub Liste(Yol As String)
Dim fL As Object, f As Object, j As Long, n As Long
Set fL = CreateObject("Scripting.FileSystemObject")

aranan_Uzanti = LCase(fL.GetExtensionName(Application.AddIns.Item(1).FullName))

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wb As Workbook
For Each dosya In fL.getfolder(Yol).Files

Uzanti = LCase(fL.GetExtensionName(dosya.Name))

If aranan_Uzanti = "xlam" Then
If Uzanti = "xls" Or Uzanti = "xlsm" Or Uzanti = "xlsx" Or Uzanti = "xlsb" Then
Else
GoSub Atla
End If
End If

If aranan_Uzanti = "xla" Then
If Uzanti <> "xls" Then
GoSub Atla
Else
End If
End If

If ThisWorkbook.Name = dosya.Name Then GoSub Atla
If "~$" & ThisWorkbook.Name = dosya.Name Then GoSub Atla

Set wb = Workbooks.Open(dosya, Password:="", WriteResPassword:="")
Set fL = CreateObject("Scripting.FileSystemObject")
dosya_adi = fL.GetBaseName(dosya)

wb.Worksheets.Select
say = CreateObject("Scripting.FileSystemObject").getfolder(Yol).Files.Count + 1
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Yol & "\" & say & " " & dosya_adi & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
wb.Close False

Atla:

Next

On Error GoTo sonraki
For Each f In fL.getfolder(Yol).SubFolders
Liste (f.Path)
sonraki:
Next

Set fL = Nothing
End Sub
 
Merhaba,
Aynı durum word dosyaları için de olurmu ?
Yani klasör içindeki word dosyalarını topluca ayrı ayrı pfd e çevirebilirmiyiz acaba?
Teşekkürler.
 
joker61tr' Alıntı:
Merhaba,
Aynı durum word dosyaları için de olurmu ?
Yani klasör içindeki word dosyalarını topluca ayrı ayrı pfd e çevirebilirmiyiz acaba?
Teşekkürler.
Genişletmek için tıkla ...

kod:

Kod: 
Sub word_pdf_dosyasi_yap()

Set Klasor = CreateObject("shell.application").browseforfolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.SELF.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Liste2 (Kaynak)
Application.ScreenUpdating = True
Application.DisplayAlerts = True

MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
    
End Sub
 
Private Sub Liste2(Yol As String)
Dim fL As Object, f As Object
Set fL = CreateObject("Scripting.FileSystemObject")

For Each dosya In fL.getfolder(Yol).Files

Uzanti = LCase(fL.GetExtensionName(dosya.Name))
dosya_adi = fL.GetBaseName(dosya)

If Uzanti = "doc" Or Uzanti = "docx" Then

Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Set wrdApp = CreateObject("Word.Application")
wrdApp.Documents.Open (dosya)
wrdApp.Visible = True
say = CreateObject("Scripting.FileSystemObject").getfolder(Yol).Files.Count + 1
wrdApp.ActiveDocument.ExportAsFixedFormat OutputFileName:=Yol & "\" & say & " " & dosya_adi & ".pdf", ExportFormat:=wdExportFormatPDF

wrdApp.Quit
Set wrdApp = Nothing

End If
Atla:

Next

On Error GoTo sonraki
For Each f In fL.getfolder(Yol).SubFolders
Liste2 (f.Path)
sonraki:
Next

Set fL = Nothing
End Sub

not: bilgisayarınızda ofis 2007 ve üzeri word yüklü olması gerekiyor.
 
Merhaba, ilgi ve alakanız için teşekkür ederim.

Office 2010 kullanıyorum, fakat "user-defined type not defined" diye bir hata veriyor.
Klasör seçiyor fakat sonrasında hata veriyor.

Private Sub Liste2(Yol As String)
Dim fL As Object, f As Object
Set fL = CreateObject("Scripting.FileSystemObject")

For Each dosya In fL.getfolder(Yol).Files

Uzanti = LCase(fL.GetExtensionName(dosya.Name))
dosya_adi = fL.GetBaseName(dosya)

If Uzanti = "doc" Or Uzanti = "docx" Then

************Dim wrdApp As Word.Application BURADA HATA VERİYOR !*************
Dim wrdDoc As Word.Document
Set wrdApp = CreateObject("Word.Application")
wrdApp.Documents.Open (dosya)
wrdApp.Visible = True
say = CreateObject("Scripting.FileSystemObject").getfolder(Yol).Files.Count + 1
wrdApp.ActiveDocument.ExportAsFixedFormat OutputFileName:=Yol & "\" & say & " " & dosya_adi & ".pdf", ExportFormat:=wdExportFormatPDF

wrdApp.Quit
Set wrdApp = Nothing

End If
Atla:

Next

On Error GoTo sonraki
For Each f In fL.getfolder(Yol).SubFolders
Liste2 (f.Path)
sonraki:
Next

Set fL = Nothing
End Sub
 
Referanslar listesinden bunu ekleyin.

Kod: 
microsoft word [COLOR="Red"]12.0[/COLOR] object library

kırmızı yerin rakamı sizde farklı olabilir onu ekleyiniz.


 
Teşekkürler, emeğinize sağlık.
Kısmen de olsa işimi gördü. (altışar olarak çeviriyor :) )
 
Arkadaşlar bende de excel dosyası içindeki sayfaları makro kontrolü ile toplu halde seçip (duruma göre bu sayfalar değişecek), daha sonra pdf yapacağım. PDF yapmada sorun yok ama sayfaları toplu seçmede sıkıntı var.

Aşağıdataki komutu bir türlü kontrol altına alamadım
Sheets(Array("Sayfa1", "Sayfa3", "Sayfa8")).Select
 
joker61tr' Alıntı:
Teşekkürler, emeğinize sağlık.
Kısmen de olsa işimi gördü. (altışar olarak çeviriyor :) )
Genişletmek için tıkla ...

Uygulamada Kısıtlama varmı bilmiyorum ama ben 18 adet dosyada denedim hepsinide pdf ye çevirdi
 
bayram' Alıntı:
Arkadaşlar bende de excel dosyası içindeki sayfaları makro kontrolü ile toplu halde seçip (duruma göre bu sayfalar değişecek), daha sonra pdf yapacağım. PDF yapmada sorun yok ama sayfaları toplu seçmede sıkıntı var.

Aşağıdataki komutu bir türlü kontrol altına alamadım
Sheets(Array("Sayfa1", "Sayfa3", "Sayfa8")).Select
Genişletmek için tıkla ...

Aşağıdaki linkleri irdeleyiniz.
ayrıca dosyadaki bütün sayfalar için şöyle deneyiniz.

Kod: 
Sheets(Array("Sayfa1", "Sayfa3", "Sayfa8")).Select
bunun yerine
Kod: 
ThisWorkbook.Worksheets.Select
bunu deneyiniz.

http://www.excel.web.tr/f48/ko-ullu-ve-birle-tirerek-pdf-kaydetme-t147913.html

http://www.excel.web.tr/f48/birle-351-tirerek-pdf-kaydetme-t146723.html

http://www.excel.web.tr/f48/secili-sayfalary-pdf-olarak-kaydetme-t145431.html
 
Halit Hocam ben derdimi anlatamadım ;
Userform üzerinde yapılacak seçime göre sayfa adları oluşacak (bunlar bir hücreye yazılacak) ve bu sayfaları toplu seçerek pdf'e dönüştürmek.

Sheets(Array("Sayfa1", "Sayfa3", "Sayfa8")).Select
Her makro çalıştığında bu komutu excel sayfasında oluşan sayfa isimleri ile değiştirebileyim.

Örnek;
ko = Worksheets("PPPP").Cells(10, 12) -- "P1","P2","P4"

Sheets(Array(ko)).Select

hata veriyor.
 
bayram' Alıntı:
Halit Hocam ben derdimi anlatamadım ;
Userform üzerinde yapılacak seçime göre sayfa adları oluşacak (bunlar bir hücreye yazılacak) ve bu sayfaları toplu seçerek pdf'e dönüştürmek.

Sheets(Array("Sayfa1", "Sayfa3", "Sayfa8")).Select
Her makro çalıştığında bu komutu excel sayfasında oluşan sayfa isimleri ile değiştirebileyim.

Örnek;
ko = Worksheets("PPPP").Cells(10, 12) -- "P1","P2","P4"

Sheets(Array(ko)).Select

hata veriyor.
Genişletmek için tıkla ...

Bu konu baya karıştı siz sorunuzu farklı bir konu başlığı altında örnek dosyanızı ekliyerek sorunuz.
 
Merhaba ben kendime uyarlayamadim nerde hata yapiyorum aynisini alip yaptistrdim makroda atadim ancak degsitrmem gereken ve ilk klasor seciminde secmem gereken yer neresi yardimci olur msuunuz
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst