Toplu halde html dosyalarını pdf e cevirme

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,701
Excel Vers. ve Dili
Excel 2019 Türkçe
Arkadaşlar merhaba,
Html uzantılı dosyaları nasıl toplu halde pdf e cevirebiliz?
Konu hakkında yardımlarınızı bekliyorum.
ıyi çalışmalar dilerim
 
Katılım
20 Şubat 2012
Mesajlar
242
Excel Vers. ve Dili
office2007 Türkçe
Python programı ile aşinalığınız varsa aşağıdaki kod ile yapabilirsiniz. Denedim çok güzel çalışıyor.

import glob,os
import pdfkit #pip install pdfkit
path_wkhtmltopdf = r"C:\Program Files\wkhtmltopdf\bin\wkhtmltopdf.exe"
config = pdfkit.configuration(wkhtmltopdf=path_wkhtmltopdf)
newList=[]
for filename in glob.iglob(os.path.join('*.html')):
newList.append(filename)
pdfkit.from_file(newList, 'out.pdf', configuration=config)

link :

 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,701
Excel Vers. ve Dili
Excel 2019 Türkçe
Aslında ben biraz yol kat ettim. Sadece dosyaların (output ) nereye çıkarılacağı kısmında takıldım. Belki fikri olan arkadaşlar vardır.
Kod:
Sub PrintViaMicrosoftToPDF()
'Save the current active printer for later reset:
Dim OldPrinter
OldPrinter = Trim(Split(Application.ActivePrinter, "in")(0))
'Define the new active printer
CreateObject("WScript.Network").SetDefaultPrinter "Microsoft Print to PDF"
Dim objShell
Set objShell = CreateObject("WScript.Shell")
Dim IE As InternetExplorer
Set IE = New InternetExplorerMedium ' New InternetExplorer
IE.Visible = True
Dim FSO As Scripting.FileSystemObject
Dim objfolder As Scripting.Folder
Dim objfiles As Scripting.Files
Dim F As Scripting.File
FilePath = ThisWorkbook.Path & "\htm\"
Set FSO = New Scripting.FileSystemObject
Set objfolder = FSO.GetFolder(FilePath)
Set objfiles = objfolder.Files
For Each F In objfiles
IE.Navigate2 F.Path
Do While IE.readyState <> 4
DoEvents
Loop
'Prints but prompts :(
'IE.ExecWB 6, 2, "", ""
IE.ExecWB 6, 2, 0, 0
Next
'Reset Printer
CreateObject("WScript.Network").SetDefaultPrinter OldPrinter
End Sub[code]
 
Katılım
20 Şubat 2012
Mesajlar
242
Excel Vers. ve Dili
office2007 Türkçe
Ücretsiz Hamitcan bey. Vbs ile dosyalarınızı tek tek açıp sendkey copy yapmak isterseniz (yapılabilirliği konusunda şüphem var) bu vbs program işinize yarayabilir.
Ancak python daha kolay.

Kod:
'===========================================================================
'  Bu program  ile belirli folderdaki tüm dosyalar sıra ile açılır. Açılan doyalarınız tarafınızdan kapatıldıkça
' program klasördeki dosyaları açmaya devam eder.
'===========================================================================

Call ExecuteDirectory("C:\Users\kullanıcı\Desktop\Stack_Html - Kopya") 'Klasör yolu


Function ExecuteDirectory(strPath2Folder)
    Dim fso, f, fc, f1, strFiles, intFiles
    Dim WshShell

    Set WshShell = CreateObject("WScript.Shell")

    strFiles = ""

    Set fso = CreateObject("Scripting.FileSystemObject")
    If (fso.FolderExists(strPath2Folder)) Then
        Set f = fso.GetFolder(strPath2Folder)
        Set fc = f.Files

        '-- Execute each file in Folder
       For Each f1 in fc 
        Dim fileToRun
        fileToRun = strPath2Folder & "\" & f1.Name
        WshShell.Run Chr(34) & fileToRun & Chr(34), 1, true
    Next

        Set f1 = Nothing
        Set fc = Nothing
        Set f = Nothing


    End If
    Set fso = Nothing
End Function

Ayrıca bakınız:


link
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,701
Excel Vers. ve Dili
Excel 2019 Türkçe
Teşekkür ederim ilginiz için. Pyton programını bir ara indirip deneyeceğim. Fakat şimdilik göndermiş kod üzerinden ilerlemek istiyorum. Aslında kod çalışıyor fakat her dosyayı çevirdiğinde ne isimle ve nereye kaydedeceğini soruyor. Burayı aşabilirsem, süper olacak.
 

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,642
Excel Vers. ve Dili
Pro Plus 2021
Kod:
Sub test()

    progName = "D:\htmlToPdf\htmlToPdf_.exe"
    htmlPath = "D:\Test"
    'CreateObject("WScript.Shell").Run progName & " " & htmlPath, 1, True
    Shell progName & " " & htmlPath
End Sub
Lınktekı rar dosyasını bır klasore çıkartın. Adresını progName de düzeltın. Programda kullanılan Dll'ın kullanımı ıçın sınır var mı bılmıyorum.
Insallah calısır.
 
Katılım
18 Mayıs 2009
Mesajlar
1,184
Excel Vers. ve Dili
Excel 2016 Türkçe
Hamitcan uzmanım merhaba
Pdfye çevirme konusunda ücretli veya ücretsiz bir çok program vardır. Ben internetten indirdiğim bir programı deneyeceğim zaman, boş bir dosyaya Türkçe karakterleri yazarım. çşğıöü gibi. Eğer bu karakterleri hatasız pdfye çeviriyorsa ilk testi atlatmış demektir.

Bu şekilde birinci öncelikli olarak iki program ismi önereceğim.

Pdf Ceeator Plus
ve
Pdf24 creator

iki prog için de “çok güzel” diye not yazmışım. (Pdf24 creator ücretsiz)

Ayrıca Bullzip pdf printer
Pdf Factory Pro
Pdf Creator
Transformer2 ve
Aloha pdf suite denenebilir.

Bir küçük hatırlatma daha yapmak istiyorum. Bazı programlar Ctrl P ile (yazıcı gibi) pdf oluşturur, bazıları da
(Pdf24 creator gibi), pdfyi içinden oluşturur.

Umarım html konusunda işinizi görür bunlar. İyi çalışmalar.
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,701
Excel Vers. ve Dili
Excel 2019 Türkçe
Arkadaşlar teşekkür ederim. Her iki öneriyi de deneyeceğim. Sonuçları bildireceğim. İyi akşamlar dilerim.
 
Katılım
5 Eylül 2007
Mesajlar
1,247
Excel Vers. ve Dili
ofis 2010
Altın Üyelik Bitiş Tarihi
21-07-2024
Kod:
Sub test()

    progName = "D:\htmlToPdf\htmlToPdf_.exe"
    htmlPath = "D:\Test"
    'CreateObject("WScript.Shell").Run progName & " " & htmlPath, 1, True
    Shell progName & " " & htmlPath
End Sub
Lınktekı rar dosyasını bır klasore çıkartın. Adresını progName de düzeltın. Programda kullanılan Dll'ın kullanımı ıçın sınır var mı bılmıyorum.
Insallah calısır.
Çok teşekkür ederim, gayet pratik ve sorunsuz çalışıyor, toplu olarak pdf' e çeviriyor. İyi çalışmalar.
Not: DLL kullanımı sınırlı ise bunu sınırsıza çevirme yapılabilir mi?
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,701
Excel Vers. ve Dili
Excel 2019 Türkçe
Kod:
Sub test()

    progName = "D:\htmlToPdf\htmlToPdf_.exe"
    htmlPath = "D:\Test"
    'CreateObject("WScript.Shell").Run progName & " " & htmlPath, 1, True
    Shell progName & " " & htmlPath
End Sub
Lınktekı rar dosyasını bır klasore çıkartın. Adresını progName de düzeltın. Programda kullanılan Dll'ın kullanımı ıçın sınır var mı bılmıyorum.
Insallah calısır.
Veysel Bey merhaba,
Kodu çalıştırdım ama dosyaları bulamıyorum. Dosyaları nereye çıkartıyor ?
Teşekkür ederim.
 
Katılım
5 Eylül 2007
Mesajlar
1,247
Excel Vers. ve Dili
ofis 2010
Altın Üyelik Bitiş Tarihi
21-07-2024
Veysel Bey merhaba,
Kodu çalıştırdım ama dosyaları bulamıyorum. Dosyaları nereye çıkartıyor ?
Teşekkür ederim.
test klasörünün içinde oluyor ancak klasörde değil de buraya çıkart şeklinde, yani html uzantılı dosyalar şeklide oluyor
 
Katılım
15 Mart 2005
Mesajlar
379
Excel Vers. ve Dili
Microsoft 365 En 64 Bit
Altın Üyelik Bitiş Tarihi
20-03-2024
@hamitcan,

Konu biraz eski ama...
Eğer sorununu çözmediysen aşağıdaki kodu denersiniz.

C++:
Sub PrintViaMicrosoftToPDF()
'Save the current active printer for later reset:
Dim OldPrinter
OldPrinter = Trim(Split(Application.ActivePrinter, "in")(0))
'Define the new active printer
CreateObject("WScript.Network").SetDefaultPrinter "Microsoft Print to PDF"

Dim IE As InternetExplorer
Dim fso As Scripting.FileSystemObject
Dim objfolder As Scripting.Folder
Dim objfiles As Scripting.Files
Dim f As Scripting.File

filePath = ThisWorkbook.Path & "\htm\"

Set fso = New Scripting.FileSystemObject
Set objfolder = fso.GetFolder(filePath)
Set objfiles = objfolder.Files

For Each f In objfiles
    Call Close_IEopenedWindows
    'Set IE = New InternetExplorerMedium ' New InternetExplorer
    Set IE = GetObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}")
    IE.navigate "file:///" & (f.Path)
    IE.Visible = True
    pdfFilePath = objfolder & "\" & fso.GetBaseName(f) & ".pdf"
    'IE.Navigate2 f.Path
    Do While IE.readyState <> 4
        DoEvents
    Loop
    'Prints but prompts :(
    'IE.ExecWB 6, 2, "", ""
    IE.ExecWB 6, 2, 0, 0
    
    Application.Wait Now + TimeValue("00:00:02")
    Application.SendKeys pdfFilePath, True
    
    Application.Wait Now + TimeValue("00:00:02")
    Application.SendKeys "{ENTER}"
    
    Application.Wait Now + TimeValue("00:00:01")
Next

Call Close_IEopenedWindows
Set fso = Nothing: Set objfolder = Nothing: Set objfiles = Nothing: Set IE = Nothing
'Reset Printer
CreateObject("WScript.Network").SetDefaultPrinter OldPrinter
End Sub

Sub Close_IEopenedWindows()
    Dim objWMI As Object, objProcess As Object, objProcesses As Object
    Set objWMI = GetObject("winmgmts://.")
    Set objProcesses = objWMI.ExecQuery( _
        "SELECT * FROM Win32_Process WHERE Name = 'iexplore.exe'")
    On Error Resume Next
    For Each objProcess In objProcesses
        Call objProcess.Terminate
    Next
    Set objShell = Nothing: Set objProcesses = Nothing: Set objShell = Nothing
End Sub
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,701
Excel Vers. ve Dili
Excel 2019 Türkçe
@hamitcan,

Konu biraz eski ama...
Eğer sorununu çözmediysen aşağıdaki kodu denersiniz.

C++:
Sub PrintViaMicrosoftToPDF()
'Save the current active printer for later reset:
Dim OldPrinter
OldPrinter = Trim(Split(Application.ActivePrinter, "in")(0))
'Define the new active printer
CreateObject("WScript.Network").SetDefaultPrinter "Microsoft Print to PDF"

Dim IE As InternetExplorer
Dim fso As Scripting.FileSystemObject
Dim objfolder As Scripting.Folder
Dim objfiles As Scripting.Files
Dim f As Scripting.File

filePath = ThisWorkbook.Path & "\htm\"

Set fso = New Scripting.FileSystemObject
Set objfolder = fso.GetFolder(filePath)
Set objfiles = objfolder.Files

For Each f In objfiles
    Call Close_IEopenedWindows
    'Set IE = New InternetExplorerMedium ' New InternetExplorer
    Set IE = GetObject("new:{D5E8041D-920F-45e9-B8FB-B1DEB82C6E5E}")
    IE.navigate "file:///" & (f.Path)
    IE.Visible = True
    pdfFilePath = objfolder & "\" & fso.GetBaseName(f) & ".pdf"
    'IE.Navigate2 f.Path
    Do While IE.readyState <> 4
        DoEvents
    Loop
    'Prints but prompts :(
    'IE.ExecWB 6, 2, "", ""
    IE.ExecWB 6, 2, 0, 0
   
    Application.Wait Now + TimeValue("00:00:02")
    Application.SendKeys pdfFilePath, True
   
    Application.Wait Now + TimeValue("00:00:02")
    Application.SendKeys "{ENTER}"
   
    Application.Wait Now + TimeValue("00:00:01")
Next

Call Close_IEopenedWindows
Set fso = Nothing: Set objfolder = Nothing: Set objfiles = Nothing: Set IE = Nothing
'Reset Printer
CreateObject("WScript.Network").SetDefaultPrinter OldPrinter
End Sub

Sub Close_IEopenedWindows()
    Dim objWMI As Object, objProcess As Object, objProcesses As Object
    Set objWMI = GetObject("winmgmts://.")
    Set objProcesses = objWMI.ExecQuery( _
        "SELECT * FROM Win32_Process WHERE Name = 'iexplore.exe'")
    On Error Resume Next
    For Each objProcess In objProcesses
        Call objProcess.Terminate
    Next
    Set objShell = Nothing: Set objProcesses = Nothing: Set objShell = Nothing
End Sub
Sayın dost, teşekkür ederim öncelikle cevabınız için. Konuyu nasıl hallettim hatırlamıyorum inanın. Ama verdiğiniz kodu saklayacağım. Mutlaka işime yarayacaktır.
 
Üst