• DİKKAT

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

Word Dosyalarını PDF'ye Çevirme

Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
B

baysevimli

Katılım
13 Eylül 2015
Mesajlar
201
Excel Vers. ve Dili
2010 VBA
Arkadaşlar Merhaba,

"C:\dosya" içinde 10'a yakın Word dosyam var. Bir makro ile bütün klasördeki tüm Word dosyalarının aynı klasör içinde ve aynı dosya isimleri ile PDF formatına çevrilmesini sağlayabilir miyiz ?

Teşekkür ederim.
 
Merhaba,
Bir Word dosyası açıp aşağıdaki kodu deneyiniz.
Kod: 
Sub KOD()
Dim UZ As String, YL As String, DSY As String, Dosya As Document
YL = "[COLOR="Red"]C:\dosya\[/COLOR]"
DSY = Dir(YL, vbNormal)
Do While DSY <> ""
    uznt = Split(DSY, ".")
    UZ = uznt(UBound(uznt))
    If UZ Like "doc*" Then
        Set Dosya = Documents.Open(YL & DSY)
        Dosya.ExportAsFixedFormat OutputFileName:=YL & uznt(0), ExportFormat:=wdExportFormatPDF
        Dosya.Close
    End If
DSY = Dir
Loop
End Sub
 
Sn. Mucit Merhaba
Size telefonumdan yazıyorum o sebeple henüz test edemedim. Sabah test edip bilgi vereceğim. Yalnız word dosyası açın demişsiniz ama ben excel üzerinden yapmak istiyorum word doslarımın pdf e çevirme işlemini. Bu kodu excelin vba editörüne alsam çalışır mı ?
İlginize teşekkür ederim.
 
Halit bey merhaba,

Link için teşekkürler, inceledim istediğim sonucu alıyorum bu kodlarla ama makro hedef klasörü belirlemek için bowser açıyor. Browser değilde C:\\Dosya içini hedef olarak gösterebilir miyiz ?
 
Mucit bey
bu arada az önce verdiğiniz kodu excelde bir modül içinde denedim. Aşağıdaki satırda hata aldım.

Set Dosya = Documents.Open(YL & DSY)
 
baysevimli' Alıntı:
Halit bey merhaba,

Link için teşekkürler, inceledim istediğim sonucu alıyorum bu kodlarla ama makro hedef klasörü belirlemek için bowser açıyor. Browser değilde C:\\Dosya içini hedef olarak gösterebilir miyiz ?
Genişletmek için tıkla ...

kod

Kod: 
Sub word_pdf_dosyasi_yap()

Kaynak = [COLOR="Red"]"C:\bilgisayar\Pdf dosyaları"[/COLOR]

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

MsgBox "işlem tamam"
 
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
 
Halit bey sizden bişey daha rica edicem.

Çalışmamı aşağıdaki kod ile yapmaya karar verdim. Yani hedef klasörümü browser ile yapıcam. sizden ricam şu; browserda seçtiğim klasörün yolunu Excelimdeki A1 hücreme yazsın. İlginiz için teşekkür ederim.

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
 
Değerli Arkadaşlar,

Yardımcı olabilir misiniz ?

Aşağıda Word dosyalarımı Pdf ye çeviren bir kodum var. Kodları çalıştırdığımda bana bir browser açıyor ve çevriyi yapacağı klasör yolunu seçmemi istiyor. İstediğimde şu; browserda seçtiğim klasör yolunu Excelimin A1 hücresine yazsın.


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

Kod: 
Range("A1").Value = Klasor.SELF.Path
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Geri
Üst