Convertir tous les fichiers ".docx" d'un dossier en pdf

Fermé
Signaler
-
 Mosca -
Bonjour,

Je vous explique mon problème :

J'aimerais faire un code qui me permet depuis excel (avec un bouton nommé MAJ par exemple) de convertir tout les fichiers d'un dossier "convertir" en pdf.

Ces fichiers sont au format ".docx" et il y en a plein (environ 100) j'aimerais donc ne pas les ouvrir et j'aimerais aussi qu'ils garde leur nom, juste l'extension doit changer.

Idéalement j'aimerais que les fichiers, une fois convertis en .pdf se déplacent dans un autre dossier "fait".

J'ai récupéré des bout de code sur internet pour m'aider mais je n'arrive pas à faire ce que je veux.

Mon code :

Dans un module de classe :

Option Explicit

Private mvarNomFichier As String
Private mvarNomDir As String
Private mvarChemDocComplet As String
'Set PdfApp = CreateObject("PDFCreator.Application")
'Reference.AddFromFile ("C:\Program Files\PDFCreator.exe")

'
' IMPORTANT : le composant est déclaré avec ses évènements
Private WithEvents PDFCreator1 As PDFCreator.clsPDFCreator ' composant principal
Private pErr As clsPDFCreatorError '/ classe de gestion d'erreur
Private opt As clsPDFCreatorOptions '/ classe de paramétrage

Private noStart As Boolean '/ variable de contrôle

Private ImprimanteParDefaut As String '/variable imprimante par défaut

Public Property Let ChemDocComplet(ByVal vData As String)
'/ Propriété : chemin absolu du fichier à exporter (ex : C:\Temp\monword.doc)
mvarChemDocComplet = "D:\Users\toto\Documents\convertir\" & "*" & ".docx" 'vData
End Property

Public Property Get ChemDocComplet() As String
ChemDocComplet = mvarChemDocComplet
End Property

Public Property Let NomDir(ByVal vData As String)
'/ Propriété : chemin absolu du répertoire de sortie (ex : C:\Temp\)
mvarNomDir = "D:\Users\toto\Documents\fait\"
End Property

Public Property Get NomDir() As String
NomDir = mvarNomDir
End Property

Public Property Let NomFichier(ByVal vData As String)
'/ Propriété : nom du fichier de sortie sans extension (ex : monarchive)
mvarNomFichier = "*"
End Property

Public Property Get NomFichier() As String
NomFichier = mvarNomFichier
End Property

Private Sub Class_Initialize()
'
' Instanciation des objets
Set PDFCreator1 = New clsPDFCreator
Set pErr = New clsPDFCreatorError
'
noStart = True
'
With PDFCreator1
.cVisible = True
If .cStart("/NoProcessingAtStartup") = False Then
If .cStart("/NoProcessingAtStartup", True) = False Then
Exit Sub
End If
' L'imprimante est occupée
.cVisible = True
End If
'
' Instanciation de l'objet clsPDFCreatorOptions avec les options par défaut
Set opt = .cOptions
.cClearCache
'/ A l'installation, PDFCreator mémorise l'imprimante système par défaut,
'/ on la mémorise dans une variable
ImprimanteParDefaut = .cDefaultPrinter
' on indique que l'imprimante a démarré
noStart = False
End With
'
End Sub

Public Sub ConversionPDF()
'
' On affecte les options de sortie qui nous intéressent à l'objet clsPDFCreatorOptions
With opt
'/ Répertoire de sortie
.AutosaveDirectory = Trim$(NomDir)
'/ Fichier de sortie
.AutosaveFilename = Trim$(NomFichier)
.UseAutosave = 1
.UseAutosaveDirectory = 1
'/ format de sortie (0 = PDF)
.AutosaveFormat = 0
End With
'
'/ on affecte ensuite les nouvelles options au composant principal clsPDFCreator
Set PDFCreator1.cOptions = opt
'/ On définit l'imprimante virtuelle comme imprimante par défaut
PDFCreator1.cDefaultPrinter = "PDFCreator"
'/ Impression du document Word (ou autre)
PDFCreator1.cPrintFile Trim$(ChemDocComplet)
'/ On affecte la propriété cPrinterStop à False pour contrôle ultérieur
PDFCreator1.cPrinterStop = False
'
' Tant que la propriété de cPrinterStop est à False, on laisse le temps au composant
' de terminer l'export PDF
While PDFCreator1.cPrinterStop = False
DoEvents
Wend
'
End Sub

Private Sub PDFCreator1_eReady() ' === ÉVÈNEMENT ==='

'!!!! IMPORTANT!!!! c'est en interceptant l'évènement _eReady qu'on sait que l'impression PDF
' est terminé et l'imprimante libérée : cela permet de sortir de la boucle ci-dessus
PDFCreator1.cPrinterStop = True
'
End Sub

Private Sub PDFCreator1_eError() ' === ÉVÈNEMENT ==='
Set pErr = PDFCreator1.cError
MsgBox "Error[" & pErr.Number & "]: " & pErr.Description
' en cas d'erreur, on restaure l'imprimante par défaut du système via la classe principale
PDFCreator1.cDefaultPrinter = ImprimanteParDefaut
'
End Sub

Private Sub Class_Terminate()
'
'/ restauration de l'imprimante par défaut
PDFCreator1.cDefaultPrinter = ImprimanteParDefaut
'
If noStart = False Then
DoEvents
PDFCreator1.cClose
End If
'
DoEvents
'
Set PDFCreator1 = Nothing
Set pErr = Nothing
Set opt = Nothing
'
End Sub

Sub PdfCr(NomDir As String, NomFichier As String)
Dim clExp As ExportPDF
Set clExp = New ExportPDF
'
clExp.NomDir = NomDir
clExp.NomFichier = NomFichier
clExp.ChemDocComplet = NomDir & Replace(NomFichier, ".pdf", ".docx")
'
clExp.ConversionPDF
'
Set clExp = Nothing

End Sub




Dans thisworkbook :

Sub Conv()

Dim PauseTime As Integer
Dim wdApp As Object
Dim Start As Integer
Dim EnCours As Integer

Set wdApp = CreateObject("word.application")

wdApp.Documents.Open ("D:\Users\s584257\Documents\convertir\" & "*" & ".docx")
wdApp.ActivePrinter = "PDFCreator"

Dim FileNamePDF As String
FileNamePDF = "D:\Users\s584257\Documents\fait\" & "*" & ".pdf"
'wdApp.DisplayAlerts = wdAlertsNone
wdApp.PrintOut OutputFileName:=FileNamePDF, PrintToFile:=False

PauseTime = 4
Start = Timer
Do While Timer < Start + PauseTime
EnCours = Timer
DoEvents
Loop

wdApp.ActiveDocument.Close
wdApp.Quit
Set wdApp = Nothing
End Sub



Ps : J'ai Excel 2007 et je dispose aussi de PDFCreator

Merci par avance pour votre aide.
A voir également:

2 réponses

Messages postés
44
Date d'inscription
mercredi 11 novembre 2015
Statut
Membre
Dernière intervention
30 décembre 2015
20
1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 41989 internautes nous ont dit merci ce mois-ci

Bonjour et merci pour votre réponse.
Cependant la personne qui demande de l'aide sur le lien que vous venez de me joindre cherche à fusionner plusieurs fichiers word en un pdf. Ce qui n'est pas mon cas.
Mais merci quand meme :)
Bonjour,

Ton problème vient de la procédure Conv()
En effet, un nom de fichier ne peut pas contenir de caractères spéciaux comme * (sauf pour la fonction Dir)
Donc la ligne
wdApp.Documents.Open ("D:\Users\s584257\Documents\convertir\" & "*" & ".docx")

ne marche pas.
Il faut mettre le nom en entier ou alors, s'il y a plusieurs fichiers, passer par une boucle

Voici comment je ferais (je n'ai pas testé).
Sub Conv()

Dim PauseTime As Integer
Dim wdApp As Object
Dim Start As Integer
Dim EnCours As Integer

Set wdApp = CreateObject("word.application")

Dim FileNameDOCX As String

'premier fichier
FileNameDOCX = Dir("D:\Users\s584257\Documents\convertir\*.docx")

'début de boucle
Do While FileNameDOCX <> ""

wdApp.Documents.Open ("D:\Users\s584257\Documents\convertir\" & FileNameDOCX)
wdApp.ActivePrinter = "PDFCreator"

Dim FileNamePDF As String
Dim FileName As String

FileName = Left(FileNameDOCX, Len(FileNameDOCX) - 5)
FileNamePDF = "D:\Users\s584257\Documents\fait\" & FileName & ".pdf"

'wdApp.DisplayAlerts = wdAlertsNone
wdApp.PrintOut OutputFileName:=FileNamePDF, PrintToFile:=False

PauseTime = 4
Start = Timer
Do While Timer < Start + PauseTime
EnCours = Timer
DoEvents
Loop

wdApp.ActiveDocument.Close

'fichier suivant
FileNameDOCX = Dir()

Loop
'fin de boucle

wdApp.Quit
Set wdApp = Nothing
End Sub