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
| '------------------------------------------------------------------------------------------------
Public Function FusionAcrobatPro(FichierSource As String, _
FichierAJoindre As String, _
FichierDestination As String, _
Ouvrir As Boolean) As Boolean
'------------------------------------------------------------------------------------------------------
' Fait la fusion de deux fichiers PDF pour en générer un troisième.
' Documentation Officielle:
' https://opensource.adobe.com/dc-acrobat-sdk-docs/acrobatsdk/html2015/index.html#t=Acro12_MasterBook%2FIAC_API_OLE_Objects%2FAcroExch_PDDoc.htm
'------------------------------------------------------------------------------------------------------
' FichierSource : le fichier d'origine (qui contient les premières pages).
' FichierAJoindre : le fichier à joindre au fichier d'origine, a la suite du fichier d'origine.
' FichierDestination : le fichier qui sera générer par cette fusion.
' Ouvrir : VRAI s'il faut ouvrir le fichier fusionné.
'------------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
' Exemple:
' Call FusionAcrobatPro("C:\Users\ott_l\Downloads\FichierA.pdf", _
' "C:\Users\ott_l\Downloads\FichierB.pdf"_
' "C:\Users\ott_l\Downloads\Fusion.pdf", True)
'------------------------------------------------------------------------------------------------------
' Cas de la liaison tardive:
Const PDSaveFull = 1
' Gestion des erreurs:
Err.Clear
On Error GoTo Gest_Err
Dim oPdfDoc1 As Object
Dim oPdfDoc2 As Object
Set oPdfDoc1 = CreateObject("AcroExch.PDDoc")
Set oPdfDoc2 = CreateObject("AcroExch.PDDoc")
If oPdfDoc1.Open(FichierSource) = False Then _
Err.Raise vbObjectError, "FusionAcrobatPro", "Le fichier [" & FichierSource & "] n'a pas été trouvée."
If oPdfDoc1.GetNumPages() < 1 Then _
Err.Raise vbObjectError, "FusionAcrobatPro", "Impossible de lire les pages du fichier [" & FichierSource & "]."
If oPdfDoc2.Open(FichierAJoindre) = False Then _
Err.Raise vbObjectError, "FusionAcrobatPro", "Le fichier [" & FichierAJoindre & "] n'a pas été trouvée."
If oPdfDoc2.GetNumPages() < 1 Then _
Err.Raise vbObjectError, "FusionAcrobatPro", "Impossible de lire les pages du fichier [" & FichierAJoindre & "]."
If oPdfDoc1.InsertPages(0, oPdfDoc2, 0, oPdfDoc2.GetNumPages(), 0) = False Then _
Err.Raise vbObjectError, "FusionAcrobatPro", "Impossible de fusionné les fichiers [" & FichierSource & "] + [" & FichierAJoindre & "]."
If oPdfDoc1.Save(PDSaveFull, FichierDestination) = False Then _
Err.Raise vbObjectError, "FusionAcrobatPro", "Impossible de sauvegarder la fusion [" & FichierDestination & "]."
If Ouvrir = True Then Call Shell("Explorer.exe " & FichierDestination, vbMaximizedFocus)
' Fin du traitement:
Gest_Err:
If Err.Number <> 0 Then
MsgBox "Erreur : " & Err.Number & vbCrLf & vbCrLf _
& "Description : " & Err.Description & vbCrLf & vbCrLf _
& "Source : " & Err.Source & vbCrLf & vbCrLf _
, vbCritical, "L'application rencontre une erreur de traitement"
Else
FusionAcrobatPro = True
End If
On Error Resume Next
oPdfDoc1.Close
oPdfDoc2.Close
Set oPdfDoc1 = Nothing
Set oPdfDoc2 = Nothing
Err.Clear
End Function
'------------------------------------------------------------------------------------------------ |
