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
| 'Byref/Byval non précisé = Byref : la variable est prise en compte et pas seulement sa valeur, si elle est modifiée ici elle le sera aussi aileurs
Sub concatenerPDF(monTab, Path, NomAuto, ByVal Pagination As Boolean)
'
'Concatène plusieurs fichiers PDF
'
Const MAX_TIME As Long = 30 ' in seconds
Const SLEEP_TIME As Long = 250 ' in milliseconds
Dim strDefaultPrinter As String
Dim oFSO As Scripting.FileSystemObject
Dim T As Long
Dim strTargetPath As String
Dim strAppTitle As String
Dim strPDFFileName As String
Dim strTxtFileName As String
Dim F, I, TotPage As Integer
Dim monTexte As String
'Gestion des erreurs
On Error GoTo L_ErrConcatenerPDF
Set oFSO = CreateObject("Scripting.FileSystemObject")
'Définition du nom du projet
strAppTitle = NomAuto
strAppTitle = InputBox("Veuillez nommer le fichier :", "Nom", strAppTitle, 2)
'Attribution du nom au fichier de sortie
strPDFFileName = strAppTitle & ".pdf"
'Définition de l'emplacement du fichier de sortie
strTargetPath = Path & "\"
'Ecrasement du PDF s'il existe déjà
If Dir(strTargetPath & strPDFFileName) = strPDFFileName Then
If MsgBox("Un fichier" & strTargetPath & strPDFFileName & " existe déjà." & Chr(10) & Chr(10) & "Ce dernier sera écrasé.") = vbOK Then
Kill (strTargetPath & strPDFFileName)
Else
GoTo L_ExConcatenerPDF
End If
End If
Set oPDFCreator = Nothing
Do
Set oPDFCreator = CreateObject("PDFCreator.clsPDFCreator")
Loop Until Not oPDFCreator Is Nothing
'Vérification de l'existence du logiciel
With oPDFCreator
If .cStart("/NoProcessingAtStartup") = False Then
err.Raise 17, "No Processing At Startup", "Initialisation de PDFCreator impossible..." & vbCrLf & "Veuillez vous assurer que PDFCreator est correctement installé sur le poste notamment en tentant de créer un PDF vous-même depuis un document Word ou bien depuis un fichier Word vu de l'Explorateur."
End If
'Paramètrage du PDF
DoEvents
.cVisible = True
.cPrinterStop = True
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = strTargetPath
.cOption("AutosaveFilename") = strPDFFileName
strDefaultPrinter = .cDefaultPrinter
.cDefaultPrinter = "PDFCreator"
.cClearCache
'Envoi au logiciel des chemins des fichiers à concaténer
For F = 0 To Taille
.cPrintFile (monTab(F))
Sleep 2000
Next F
Sleep 2000
'Instruction de concaténation
.cCombineAll
'On attend que la liste d'attente soit vide
T = 0
Do While (.cCountOfPrintjobs <> 1) And (T < (MAX_TIME * 1000 / SLEEP_TIME))
T = T + 1
DoEvents
Loop
.cPrinterStop = False
End With
'Contrainte sur Access pour laisser la main à PDFCreator afin d'exécuter la commande
T = 0
m_lngReadyState = 0
Do While (m_lngReadyState = 0) And (T < (MAX_TIME * 1000 / SLEEP_TIME))
T = T + 1
Sleep SLEEP_TIME
Loop
'Remise à jour des paramètres d'impression par défaut Windows
With oPDFCreator
.cDefaultPrinter = strDefaultPrinter
Sleep 200
.cClearCache
.cClose
End With
'Si le paramètre Pagination renvoie True, on pagine le fichier créé
If Pagination = True Then
TotPage = GetPageNum(strTargetPath & strPDFFileName)
monTexte = "AN - "
Call paginerPDF(TotPage, monTexte, strTargetPath & strPDFFileName)
End If
On Error GoTo 0
L_ExConcatenerPDF:
'Libération des objets et fermeture de PDFCreator
Set oPDFCreator = Nothing
Shell "taskkill /f /im PDFCreator.exe"
Exit Sub
L_ErrConcatenerPDF:
'Information utilisateur et reprise de la fonction sur l'étiquette L_ExConcatenerPDF
MsgBox err.Description, 48, err.Source
Resume L_ExConcatenerPDF
End Sub |
Fusionner plusieurs PDF en un seul sous vba Access - ERREUR d'execution 429
Répondre avec citation
Envoyé par arr37
).
)
Partager