Discussion :

[gauhtier]

Bonjour,

Je souhaite creer une macro sur word qui s'appliquerait a l'ensemble des fichiers words d'un repertoire et permettrais que lorsqu'on appuie sur enregistrer le fichier word, il cree automatiquement une copie de ce fichier en pdf dans un autre repertoire presentant la meme arborescence.
Je suis debutant en tout ce qui touche aux macros Auriez-vous des idees comment faire?

Je vous en remercie deja d'avance,

Cordialement,

[bruxmu]

Bonjour,

Certains logiciels, comme PrimoPDF (gratuit), créent un fichier pdf directement dans le répertoire d'origine.
Donc il te suffit d'installer PrimoPDF, qui te créera une icône sur le bureau, en forme de bouton rond.
Ensuite, il suffira de faire glisser sur ce bouton l'icône de tous tes fichiers Word, et tu récupéreras les fichiers pdf directement dans le répertoire où ils sont rangés.

[gauhtier]

Merci de ton aide, en revanche cela ne s'applique pas a mon probleme, je souhaite que le fichier arrive automatiquement dans un repertoire soeur ou sont ranges les versions pdf mais pas dans le repertoire d'origine. Deplus, je cherche a ce que l'utilisateur n'est pas a interragir avec le logiciel de convertion mais seulement a appuyer sur enregistrer dans le word.
En tout cas merci pour l'info, je vais voir si je peux en faire quelque chose

[bruxmu]

Rebonjour,

Si tu disposes d'Acrobat Pro, il fait ce que tu souhaites, mais il faut ouvrir chaque fichier et lancer la conversion en pdf.

[gauhtier]

Rebonjour,

Toutes les versions d'acrobate le font il me semble mais ce que je souhaite c'est tout cela se fasse en automatique sans avoir a interragir avec quoique ce soit d'autre que mon fichier word, et donc que la destination soit automatique

[Souriane]

Bonjour,

Voici la macro que j'utilise pour quelque chose de semblable. Tu n'auras qu'à l'adapter.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
Public Sub BatchPDF()
'Pour transformer tout un répertoire en PDF
'Demande à l'utilisateur quel est le répertoire Source et quel est le répertoire Destination
 
Application.ScreenUpdating = False
 
Dim myFile As String 'Mon fichier Word
Dim strDoc As String 'Mon nom de fichier PDF
Dim strRepertoireDoc As String 'Répertoire sélectionné par l'utilsateur pour l'endroit des Word
Dim strRepertoirePDF As String 'Répertoire sélectionné par l'utilsateur pour où sauvegarder PDF
Dim strAnswerA As String
Dim fDialog As FileDialog 'La Boîte de dialogue de répertoire
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
 
'Error handler
On Error Resume Next
 
'Demande de sélectionner le répertoire où se trouvent les documents
strAnswerA = MsgBox( _
"TOUS les documents du répertoire que vous sélectionnerez seront convertis en PDF (sans écraser la version Word)." _
& vbCrLf & "ET" & vbCrLf & _
"Si des documents existent dans le répertoire destination et qu'ils portent le même nom, ils seront ÉCRASÉS." _
& vbCrLf & vbCrLf & "Voulez-vous continuer?", vbYesNo, _
"JoeBine ou Autre?")
 
If strAnswerA = vbYes Then
        'Ouvre la boîte de dialogue pour choisir un répertoire avec par défaut Autre
        With fDialog
        .Title = "Sélectionnez le répertoire où se trouvent les documents Word (Source)"
        .AllowMultiSelect = False
        .InitialFileName = "c:\Autre"
        .InitialView = msoFileDialogViewList
            If .Show <> -1 Then 'Si l'utilisateur appuie sur "Annuler"
                MsgBox "Annulé par l'utilisateur", , _
                "Macro annulée"
                Exit Sub
            End If
         strRepertoireDoc = fDialog.SelectedItems(1)
            If Right(strRepertoireDoc, 1) <> "\" _
            Then strRepertoireDoc = strRepertoireDoc + "\"
        End With
Else: Exit Sub
    End If
 
strAnswerA = 0
 
'Demande de sélectionner le répertoire où sauvegarder
strAnswerA = MsgBox("Voulez-vous sauvegarder directement dans les répertoire de JoeBine?", vbYesNoCancel, _
"JoeBine ou Autre?")
 
If strAnswerA = vbYes Then
        'Ouvre la boîte de dialogue pour choisir un répertoire avec par défaut répertoire de JoeBine
        With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Sélectionnez le répertoire où SAUVEGARDER les documents PDF (Destination)"
        .AllowMultiSelect = False
        .InitialFileName = "c:\temp\"
            If .Show <> -1 Then 'Si l'utilisateur appuie sur "Annuler"
                MsgBox "Annulé par l'utilisateur", , _
                "Macro annulée"
                Exit Sub
            End If
           strRepertoirePDF = .SelectedItems(1)
           If Right(strRepertoirePDF, 1) <> "\" _
            Then strRepertoirePDF = strRepertoirePDF + "\"
 
        End With
 Else
        'Ouvre la boîte de dialogue pour choisir un répertoire avec par défaut Ailleur
        With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "c:\autre\"
        .Title = "Sélectionnez le répertoire où SAUVEGARDER les documents PDF (Destination)"
        .AllowMultiSelect = False
            If .Show <> -1 Then 'Si l'utilisateur appuie sur "Annuler"
                MsgBox "Annulé par l'utilisateur", , _
                "Macro annulée"
                Exit Sub
            End If
        strRepertoirePDF = .SelectedItems(1)
        If Right(strRepertoirePDF, 1) <> "\" _
            Then strRepertoirePDF = strRepertoirePDF + "\"
        End With
End If
 
 
'Set the directory and type of file to batch process
myFile = Dir$(strRepertoireDoc & "*.doc*")
 
While myFile <> ""
WordBasic.DisableAutoMacros 1   'Disables auto macros
 
    'Open document
        Documents.Open (strRepertoireDoc & "\" & myFile)
 
    'Détermine le nom à donner au fichier pdf
        strDoc = Left(myFile, Len(myFile) - 4)
        strDoc = strRepertoirePDF & strDoc & ".pdf"
 
   'Envoie à "l'impression" PDF
   ActiveDocument.ExportAsFixedFormat outputFileName:=strDoc _
        , exportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False
 
   'Ferme le fichier Word sans sauvegarder
ActiveDocument.Close wdDoNotSaveChanges
 
    'Next file in folder
 
    myFile = Dir$()
 
Wend
 
WordBasic.DisableAutoMacros 0   'Enables auto macros
 
    On Error GoTo 0 ' resume normal error handling
 
End Sub

Bonne chance!

Souriane

[gauhtier]

Bonjour,

Merci beaucoup je vais essayer de decortiquer ca pour en faire ce que je veux,

[gauhtier]

Rebonjour, j'aurais ce pendant encore encore certaine questions, du style pourquoi, je ne peux pas supprimer le fichier/document cree avec la macro, je sais que c'est du au fait que j'ouvre le document en fin de macro mais une fois tout ferme je ne peux toujours pas supprimer ce qui a ete fais.
y a t-il un autre moyen de faire afficher le doc pdf cree sans avoir ce probleme?

Voici la maccro en question a l'heure d'avancement actuelle :

Public Function DossierExiste(Dossier As String) 'fonction qui verifie l'existence de dossier
If Len(Dir(Dossier, vbDirectory)) > 0 Then
DossierExiste = True
Else
DossierExiste = False
End If
End Function

Function CreerDossier(Chemin As String) 'macro qui permet de creer des dossiers et sousdossiers en meme temps
On Error GoTo CreerDossierErreur
If Len(Dir(Chemin, vbDirectory)) > 0 Then
CreerDossier = True
Exit Function
Else
If Right(Chemin, 1) = Application.PathSeparator Then Chemin = Left(Chemin, Len(Chemin) - 1)
PartiesDeChemin = Split(Chemin, Application.PathSeparator)

For PartieDeChemin = LBound(PartiesDeChemin) To UBound(PartiesDeChemin)

For CheminPartiel = LBound(PartiesDeChemin) To PartieDeChemin
CheminPartielOK = CheminPartielOK & PartiesDeChemin(CheminPartiel) & Application.PathSeparator
If CheminPartiel = PartieDeChemin Then
If Len(Dir(CheminPartielOK, vbDirectory)) = 0 Then
MkDir CheminPartielOK
End If
End If
Next CheminPartiel
CheminPartielOK = ""
Next PartieDeChemin
End If

CreerDossier = True
Exit Function
CreerDossierErreur:
CreerDossier = False
End Function

Sub ConversionPDF()

Dim fic As String, fic2 As String, intpos As Byte
Dim strRepertoireDoc As String
Dim strRepertoirePDF As String
Dim strAnswerA As String
Dim fDialog As FileDialog 'La Boîte de dialogue de répertoire

strAnswerA = MsgBox( _
"Une copie PDF de ce fichier sera cree dans le Repertoire REFERENCE," _
& vbCrLf & "Cela risque d'ECRASER les versions precedentes de ce fichier PDF." _
& vbCrLf & vbCrLf & "Voulez-vous continuer?", vbYesNo, _
"Lancement de la macro")

If strAnswerA = vbNo Then
Exit Sub
End If

fic = ActiveDocument.Name
strRepertoireDoc = ActiveDocument.Path
strRepertoirePDF = Right(strRepertoireDoc, Len(strRepertoireDoc) - 17) 'suppression du debut de l'arborescence du .doc
strRepertoirePDF = "D:\New folder (3)" & strRepertoirePDF 'ajout de la nouvelle racine d'arborescence, soit le repertoire reference pour .pdf

Dim Dossier As String
Dossier = strRepertoirePDF
'on verifie si le dossier d'arrivee existe
If DossierExiste(Dossier) = False Then
While DossierExiste(Dossier) = False 'si non on remonte l'arborescence pour voir le dernier fichier concordant
Dossier = Left(Dossier, Len(Dossier) - 1)
Wend
strAnswerA = MsgBox( _
"Le dossier correspond dans le Repertoire Reference n'existe pas," _
& vbCrLf & "le dernier dossier correspondant a cette arborescence est : " _
& vbCrLf & Dossier & vbCrLf & "L'arborescence a creer est : " _
& vbCrLf & strRepertoirePDF & vbCrLf & vbCrLf & "Voulez-vous continuer?", _
vbYesNo, "Erreur Arborescence")

If strAnswerA = vbNo Then
MsgBox "Macro Annulee"
Exit Sub
End If

Dim NouveauxDossiers As String
NouveauxDossiers = strRepertoirePDF
CreerDossier (NouveauxDossiers) ' creation des dossiers manquants
End If

intpos = InStrRev(fic, ".") 'trouve la position de l'extension
fic = Left(fic, intpos - 1) 'remplace l'extension doc par pdf
fic2 = fic & ".pdf"
'enregistre dans le dossier en cours
ActiveDocument.ExportAsFixedFormat outputFileName:=strRepertoirePDF & "/" & fic2, _
exportFormat:=wdExportFormatPDF, OpenAfterExport:=True, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
'MsgBox strRepertoirePDF


End Sub