Excel / Word / PDF avec Adobe Acrobat Pro et PDFCreator 1.7.3 (obsolète)

**kiki29** · 19/10/2013, 12h00

PDFCreator Liste exhaustive des options

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
Option Explicit
 
Sub ListeOptions()
Dim c As Collection
Dim i As Long
Dim PDFCreator1 As Object
 
    Set PDFCreator1 = CreateObject("PDFCreator.clsPDFCreator")
    Application.ScreenUpdating = False
 
    With Feuil1
        .Cells.Clear
        .Cells(1, 1) = "N°"
        .Cells(1, 2) = "Option"
        .Cells(1, 3) = "Valeur Actuelle"
        .Cells(1, 4) = "Valeur Standard"
        .Range("A1:D1").Interior.ColorIndex = 40
    End With
 
    With PDFCreator1
        .cVisible = False
        If .cStart("/NoProcessingAtStartup") = True Then
            Set c = .cOptionsNames
            For i = 1 To c.Count
                With Feuil1
                    .Cells(i + 1, 1) = i
                    .Cells(i + 1, 2) = c(i)
                    .Cells(i + 1, 3) = PDFCreator1.cOption(c(i))
                    .Cells(i + 1, 4) = PDFCreator1.cStandardOption(c(i))
                End With
            Next i
            .cClose
        End If
    End With
 
    Feuil1.Cells(1, 1).Select
 
    Application.ScreenUpdating = True
 
    Set c = Nothing
    Set PDFCreator1 = Nothing
End Sub
 
Sub Kill_PDFCreator()
Dim RetVal As Long
    RetVal = Shell("Taskkill /im PDFCreator.exe /f", 0)
End Sub

**kiki29** · 19/10/2013, 12h01

PDFCreator Rotation d'une Page

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
Option Explicit
 
Sub RotationPages()
Dim pdf As Object
Dim sIn As String
Dim FSO As Object
Dim sDossierRotation As String
 
    '    Public Function CreatePDFTestDocument( _
         '        destinationFilename As String, _
         '        countOfPages As Integer, _
         '        additionalText As String, _
         '        addPagenumbers As Boolean _
         '    ) As Integer
 
    '    Public Function RotatePages( _
         '        sourceFilename As String, _
         '        destinationFilename As String, _
         '        fromPage As Integer, _
         '        toPage As Integer, _
         '        angle As Integer _
         '    ) As Integer
 
    sDossierRotation = ThisWorkbook.Path & "\" & "Rotation"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FolderExists(sDossierRotation) Then FSO.CreateFolder (sDossierRotation)
 
    sIn = sDossierRotation & "\" & "Test Rotation de Pages.pdf"
 
    Set pdf = CreateObject("pdfforge.pdf.pdf")
 
    pdf.CreatePDFTestDocument sIn, 2, "Test Rotation de Pages", True
    pdf.RotatePages sIn, sDossierRotation & "\" & "test 0°.pdf", 1, 1, 0
    pdf.RotatePages sIn, sDossierRotation & "\" & "test 90°.pdf", 1, 2, 90
    pdf.RotatePages sIn, sDossierRotation & "\" & "test 180°.pdf", 1, 1, 180
    pdf.RotatePages sIn, sDossierRotation & "\" & "test 270°.pdf", 1, 2, 270
 
 
    Set FSO = Nothing
    Set pdf = Nothing
End Sub

**kiki29** · 19/10/2013, 12h05

PDFCreator Inclusion de fichiers en Pièces Jointes dans un PDF

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
Option Explicit
 
Sub InclusionFichiers()
Dim pdf As Object, FichiersInclus(2) As Variant
 
    Set pdf = CreateObject("pdfforge.pdf.pdf")
 
    pdf.CreatePDFTestDocument ThisWorkbook.Path & "\" & "Test.pdf", 1, "Essai Inclusion Fichier", True
    pdf.CreatePDFTestDocument ThisWorkbook.Path & "\" & "Test2.pdf", 1, "Fichier à Inclure", True
 
    FichiersInclus(0) = ThisWorkbook.Path & "\" & "Test2.pdf"
    FichiersInclus(1) = ThisWorkbook.Path & "\" & "Inclusion.doc"
    FichiersInclus(2) = ThisWorkbook.Path & "\" & "Snoopy A4.jpg"
 
    'Public Sub EmbedFilesInPDFFile ( _
     '    sourceFilename As String, _
     '    destinationFilename As String, _
     '    ByRef embedFilenames As Object(), _
     '    compress As Boolean _
     ')
 
    pdf.EmbedFilesInPDFFile_2 ThisWorkbook.Path & "\" & "Test.pdf", _
            ThisWorkbook.Path & "\" & "Inclusion Fichiers en Pièces Jointes.pdf", FichiersInclus, True
 
    Kill ThisWorkbook.Path & "\" & "Test.pdf"
    Kill ThisWorkbook.Path & "\" & "Test2.pdf"
 
    Set pdf = Nothing
End Sub

**kiki29** · 19/10/2013, 12h07

PDFCreator Extraction des Images d'un fichier PDF

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
Option Explicit
 
Sub SelFichier_ExtractionImages()
Dim Fichier As Variant
    ChDir ThisWorkbook.Path & "\"
    Fichier = Application.GetOpenFilename("Fichiers PDF (*.pdf), *.pdf", Title:="Sélection du fichier PDF")
    If Fichier = False Then Exit Sub
    ExtractionImages (Fichier)
End Sub
 
Private Sub ExtractionImages(sNomFichier As String)
Dim Pdf As Object
Dim iNbPages As Long, iNbImagesPage As Long, iNbImagesDoc As Long
Dim sDossierImages As String, FSO As Object, i As Long
 
    iNbImagesPage = 0
    iNbImagesDoc = 0
 
    Set Pdf = CreateObject("pdfforge.pdf.pdf")
    iNbPages = Pdf.numberOfPages(sNomFichier)
 
    sDossierImages = ThisWorkbook.Path & "\" & "Extraction Images"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FolderExists(sDossierImages) Then FSO.CreateFolder (sDossierImages)
 
    'Public Function ExtractImages( _
     '    sourceFilename As String, _
     '    destinationPath As String, _
     '    pageNumber As Integer, _
     '    destinationFileNamePrefix As String _
     ') As Integer
 
    For i = 1 To iNbPages
        iNbImagesPage = Pdf.ExtractImages(sNomFichier, sDossierImages, i, "Page_" & i & "_")
        iNbImagesDoc = iNbImagesDoc + iNbImagesPage
        Application.StatusBar = "Page " & i & " / " & iNbPages & " : " & iNbImagesPage & " images extraites"
    Next i
 
    Application.StatusBar = FSO.GetFileName(sNomFichier) & " : " & iNbImagesDoc & " images extraites"
 
    Set FSO = Nothing
    Set Pdf = Nothing
End Sub

**kiki29** · 19/10/2013, 12h08

PDFCreator Ajout Annotation à un fichier PDF

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
Option Explicit
 
Sub Ajout_TextAnnotationToPDFFile()
Dim pdf As Object, pdfRectangle As Object
Dim FSO As Object, sDossierAnnotation As String
 
    'Public Function AddRectangleToPDFFile( _
     '    sourceFilename As String, _
     '    destinationFilename As String, _
     '    fromPage As Integer, _
     '    toPage As Integer, _
     '    ByRef rectangleObject As pdfRectangle _
     ') As Integer
 
    'Public Function AddTextAnnotationToPDFFile ( _
     '    sourceFilename As String, _
     '    destinationFilename As String, _
     '    fromPage As Integer, _
     '    toPage As Integer, _
     '    ByRef rectangleObject As PDFRectangle, _
     '    title As String, _
     '    text As String, _
     '    icon As String, _
     '    open As Boolean, _
     '    locked As Boolean, _
     '    colorRed As Byte, _
     '    colorGreen As Byte, _
     '    colorBlue As Byte _
     ') As Integer
 
    Set pdf = CreateObject("pdfforge.pdf.pdf")
    Set FSO = CreateObject("Scripting.FileSystemObject")
 
    sDossierAnnotation = ThisWorkbook.Path & "\" & "Annotation"
    If Not FSO.FolderExists(sDossierAnnotation) Then FSO.CreateFolder (sDossierAnnotation)
 
    pdf.CreatePDFTestDocument sDossierAnnotation & "\" & "Test.pdf", 2, "Ceci est un test", True
 
    Set pdfRectangle = CreateObject("pdfforge.pdf.pdfrectangle")
    With pdfRectangle
        .LowerLeftX = 20
        .LowerLeftY = 650
        .UpperRightX = 180
        .UpperRightY = 690
        .BorderColorRed = 255
    End With
    pdf.AddRectangleToPDFFile sDossierAnnotation & "\" & "Test.pdf", sDossierAnnotation & "\" & "rectangle.pdf", 1, 0, pdfRectangle
 
    pdf.AddTextAnnotationToPDFFile sDossierAnnotation & "\" & "rectangle.pdf", sDossierAnnotation & "\" & "Annotation.pdf", 1, 0, pdfRectangle, "Titre", "Bla  bla blabla", "Comment", True, True, 255, 255, 0
 
    Set FSO = Nothing
    Set pdfRectangle = Nothing
    Set pdf = Nothing
End Sub

**dilou123** · 13/02/2014, 22h33

Bonsoir à tous,
J'ai noté que kiki29 ne s'est pas connecté depuis octobre 2013. Qui pourrait reprendre dignement son flambeau.
Je cherche simplement à modifier directement depuis VBA le champs "Auteur" d'un fichier PDF qui se trouve dans « Propriété » puis « Description » d’Acrobat Pro.
J'ai parcouru tous les Tutos et il n'y a rien à ce propos.
Merci bcp

**kiki29** · 15/02/2014, 14h05

Salut , un AVC gauche explique mon absence que j’espère provisoire du forum.
Regarde ici et la suite

**dilou123** · 16/02/2014, 21h43

Bonsoir,
Navré d’apprendre cette nouvelle. Bon repos et très bon rétablissement.
A très vite.

**dilou123** · 16/02/2014, 21h55

Dans la liste suggérée le 19/10/2013 11h58 par kiki29, il ne figure pas le champs "Auteur" (utilisation par défaut oui).
J'ai testé le champs "PDFAuthor" à tout à hasard, cela ne fonctionne pas.
Merci.

.cOption("AutosaveDirectory") =
.cOption("AutosaveFilename")=
.cOption("AutosaveFormat")=
.cOption("AutosaveStartStandardProgram")=
.cOption("PDFDisallowCopy")=
.cOption("PDFDisallowModifyAnnotations")=
.cOption("PDFDisallowModifyContents")=
.cOption("PDFDisallowPrinting")=
.cOption("PDFEncryptor")=
.cOption("PDFOwnerPass")=
.cOption("PDFOwnerPassString")=
.cOption("PDFUserPass")=
.cOption("PDFUserPassString")=
.cOption("PDFUseSecurity")=
.cOption("PrinterTempPath")=
.cOption("UseAutosave")=
.cOption("UseAutosaveDirectory")=
.cOption("UseCreationdate")=
.cOption("UseStandardAuthor")=
.cOption("DisableEmail")=
.cOption("DisableUpdateCheck")=
.cOption("PDFCompressionColorCompression")=
.coption("PDFCompressionColorCompressionJPEGMaximumFactor")=
.coption("PDFCompressionColorCompressionJPEGHighFactor")=
.coption("PDFCompressionColorCompressionJPEGMediumFactor")=
.coption("PDFCompressionColorCompressionJPEGLowFactor")=
.coption("PDFCompressionColorCompressionJPEGMinimumFactor")=
.cOption("PDFCompressionGreyCompression")=
.coption("PDFCompressionGreyCompressionJPEGMaximumFactor")=
.coption("PDFCompressionGreyCompressionJPEGHighFactor")=
.coption("PDFCompressionGreyCompressionJPEGMediumFactor")=
.coption("PDFCompressionGreyCompressionJPEGLowFactor")=
.coption("PDFCompressionGreyCompressionJPEGMinimumFactor")=
.cOption("PDFOwnerPasswordString")=
.cOption("PDFUserPasswordString")=
.cOption("RemoveAllKnownFileExtensions")=
.cOption("StandardCreationdate")=
.cOption("StandardDateformat")=
.cOption("StandardKeywords")=
.cOption("StandardModifydate")=
.cOption("StandardSubject")=
.cOption("StandardTitle")=
.cOption("ClientComputerResolveIPAddress")=

**kiki29** · 08/03/2014, 17h17

Salut, à tester plus à fond

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
Option Explicit
 
Sub Tst_SetMetaKeys()
Dim Pdf As Object
 
    Set Pdf = CreateObject("pdfforge.Pdf.Pdf")
    Pdf.CreatePDFTestDocument ThisWorkbook.Path & "\" & "MetaKeys0.Pdf", 4, "Essai", True
 
    'Public Function SetMetadataKey( _
     '    sourceFilename As String, _
     '    destinationFilename As String, _
     '    key As String, _
     '    value As String _
     ') As Boolean
 
    Pdf.SetMetadataKey ThisWorkbook.Path & "\" & "MetaKeys0.Pdf", ThisWorkbook.Path & "\" & "MetaKeys1.Pdf", "Author", "Titi"
 
    Kill ThisWorkbook.Path & "\" & "MetaKeys0.Pdf"
    Set Pdf = Nothing
End Sub

**kiki29** · 15/03/2014, 04h13

PDFCreator Ajout de Texte ( suite du post 15 )

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
Sub Tst_AjoutText()
Dim Pdf As Object, pdfText As Object, WshShell As Object
Dim sDossierIn As String, sDossierOut As String, FSO As Object
 
    Set Pdf = CreateObject("pdfforge.Pdf.Pdf")
    Set FSO = CreateObject("Scripting.FileSystemObject")
 
    sDossierOut = ThisWorkbook.Path & "\" & "Resultats PDF"
    sDossierIn = ThisWorkbook.Path & "\" & "Resultats PDF"
 
    If Not FSO.FolderExists(sDossierOut) Then FSO.CreateFolder (sDossierOut)
    If Not FSO.FolderExists(sDossierIn) Then FSO.CreateFolder (sDossierIn)
 
    Pdf.CreatePDFTestDocument sDossierIn & "\" & "Input.Pdf", 1, "Essai", True
 
    Set pdfText = CreateObject("pdfforge.Pdf.pdfText")
 
    With pdfText
        .fillOpacity = 1
 
        .FontColorBlue = 255
        .FontColorGreen = 127
        .FontColorRed = 200
 
        .FontName = "arial.ttf"
        .FontSize = 48
        .Rotation = 90
        .Text = "Hello world"
        .XPosition = 50
        .YPosition = 90
        Pdf.AddTextToPDFFile sDossierIn & "\" & "Input.Pdf", sDossierIn & "\" & "output Add Text 1.Pdf", 1, 1, pdfText
 
 
        .FontName = "comic.TTF"
        .FontColorBlue = 50
        .XPosition = 70
        .YPosition = 110
        Pdf.AddTextToPDFFile sDossierIn & "\" & "output Add Text 1.Pdf", sDossierIn & "\" & "output Add Text 2.Pdf", 1, 1, pdfText
 
        .FontColorBlue = 0
        .FontColorGreen = 57
        .FontColorRed = 255
 
        .XPosition = 90
        .YPosition = 130
        Pdf.AddTextToPDFFile sDossierIn & "\" & "output Add Text 2.Pdf", sDossierIn & "\" & "output Add Text 3.Pdf", 1, 1, pdfText
 
        .FontName = "times.TTF"
        .FontColorBlue = 255
        .FontColorGreen = 145
        .FontColorRed = 0
 
        .XPosition = 110
        .YPosition = 150
        Pdf.AddTextToPDFFile sDossierIn & "\" & "output Add Text 3.Pdf", sDossierIn & "\" & "output Add Text 4.Pdf", 1, 1, pdfText
 
        .fillOpacity = 0.125
 
        .FontColorBlue = 125
        .FontColorGreen = 125
        .FontColorRed = 125
 
        .FontName = "times.ttf"
        .FontSize = 250
        .Rotation = 30
        .Text = "Essai"
        .XPosition = 30
        .YPosition = 110
        Pdf.AddTextToPDFFile sDossierIn & "\" & "output Add Text 4.Pdf", sDossierOut & "\" & "output Add Text 5.Pdf", 1, 1, pdfText
    End With
 
    Kill sDossierIn & "\" & "Input.Pdf"
 
    Kill sDossierIn & "\" & "output Add Text 1.Pdf"
    Kill sDossierIn & "\" & "output Add Text 2.Pdf"
    Kill sDossierIn & "\" & "output Add Text 3.Pdf"
    Kill sDossierIn & "\" & "output Add Text 4.Pdf"
 
    Set pdfText = Nothing
    Set Pdf = Nothing
End Sub

**kiki29** · 18/03/2014, 16h45

Une liste des contributions à jour au 18 Mars 2014 au format xls
avec les liens aux différents posts

**kiki29** · 20/03/2014, 09h09

PDFCreator Sauver une UserForm en PDF

Créer une UserForm avec un bouton
Affecter ce bouton à CommandButton1_Click
Placer le code suivant dans UserForm1

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
Option Explicit
 
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
        ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
 
Const VK_SNAPSHOT = 44
Const VK_LMENU = 164
Const KEYEVENTF_KEYUP = 2
Const KEYEVENTF_EXTENDEDKEY = 1
 
Private Sub CommandButton1_Click()
 
    Application.ScreenUpdating = False
 
    PrintScreen
    DoEvents
 
    ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
 
    With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.197)
        .RightMargin = Application.InchesToPoints(0.197)
        .TopMargin = Application.InchesToPoints(0.197)
        .BottomMargin = Application.InchesToPoints(0.197)
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
    End With
 
    ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
 
    PdfCreator
 
    Application.DisplayAlerts = False
    Worksheets(Worksheets.Count).Delete
    Unload Me
    Application.DisplayAlerts = True
 
    Application.ScreenUpdating = True
End Sub
 
Private Sub KillPDFCreator()
Dim RetVal As Long
    RetVal = Shell("Taskkill /im PDFCreator.exe /f", 0)
End Sub
 
Private Sub PdfCreator()
Dim JobPDF As Object
Dim sNomPDF As String
Dim sCheminPDF As String
 
    sNomPDF = "UserForm2"
    sCheminPDF = ThisWorkbook.Path & "\"
 
    Set JobPDF = CreateObject("PDFCreator.clsPDFCreator")
 
    With JobPDF
        If .cStart("/NoProcessingAtStartup") = False Then
            MsgBox "Initialisation de PDFCreator impossible", vbCritical + vbOKOnly, "PDFCreator"
            Exit Sub
        End If
        .cOption("UseAutosave") = 1
        .cOption("UseAutosaveDirectory") = 1
        .cOption("AutosaveDirectory") = sCheminPDF
        .cOption("AutosaveFilename") = sNomPDF
        .cOption("AutosaveFormat") = 0
        .cClearCache
    End With
 
    ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"
 
    Do Until JobPDF.cCountOfPrintjobs = 1
        DoEvents
    Loop
 
    JobPDF.cPrinterStop = False
 
    Do Until JobPDF.cCountOfPrintjobs = 0
        DoEvents
    Loop
 
    JobPDF.cClose
    Set JobPDF = Nothing
End Sub
 
Private Sub PrintScreen()
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
End Sub

**kiki29** · 20/03/2014, 09h12

Excel 2007 Sauver une UserForm en PDF

Créer une UserForm avec un bouton
Affecter ce bouton à CommandButton1_Click
Placer le code suivant dans UserForm1

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
Option Explicit
 
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
        ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
 
Const VK_SNAPSHOT = 44
Const VK_LMENU = 164
Const KEYEVENTF_KEYUP = 2
Const KEYEVENTF_EXTENDEDKEY = 1
 
Private Sub CommandButton1_Click()
Dim sNomPDF As String
 
    Application.ScreenUpdating = False
 
    PrintScreen
    DoEvents
 
    ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
 
    With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.197)
        .RightMargin = Application.InchesToPoints(0.197)
        .TopMargin = Application.InchesToPoints(0.197)
        .BottomMargin = Application.InchesToPoints(0.197)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
    End With
 
    ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
    sNomPDF = ActiveWorkbook.Path & "\" & "UserForm.pdf"
 
    ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=sNomPDF, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=False, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
 
    Application.DisplayAlerts = False
    Worksheets(Worksheets.Count).Delete
    Unload Me
    Application.DisplayAlerts = True
 
    Application.ScreenUpdating = True
End Sub
 
Private Sub PrintScreen()
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
End Sub

**kiki29** · 06/04/2014, 00h07

PDFCreator Ecriture des métadonnées dans un fichier PDF

A voir également Lecture des métadonnées d'un fichier PDF

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
Option Explicit
 
Sub Tst_SetMetaDatas()
Dim pdf As Object, FSO As Object
Dim sDossierIn As String, sDossierOut As String
 
    Set pdf = CreateObject("pdfforge.pdf.pdf")
    Set FSO = CreateObject("Scripting.FileSystemObject")
 
    sDossierIn = ThisWorkbook.Path & "\" & "Resultats PDF"
    sDossierOut = ThisWorkbook.Path & "\" & "Resultats PDF"
    If Not FSO.FolderExists(sDossierIn) Then FSO.CreateFolder (sDossierIn)
    If Not FSO.FolderExists(sDossierOut) Then FSO.CreateFolder (sDossierOut)
 
    pdf.CreatePDFTestDocument sDossierIn & "\" & "Test.pdf", 4, "Ceci est un exemple.", True
 
    'Public Sub SetMetadata( _
     '    sourceFilename As String, _
     '    destinationFilename As String, _
     '    author As String, _
     '    creator As String, _
     '    keywords As String, _
     '    subject As String, _
     '    title As String)
 
    pdf.SetMetadata sDossierIn & "\" & "Test.pdf", sDossierIn & "\" & "MetaDatas.pdf", "Kiki", _
            "Le créateur ;-)", "Mes mots-clés : titi et toto", "échantillon pdfforge.dll", "SetMetaData"
 
    Set FSO = Nothing
    Set pdf = Nothing
End Sub

**kiki29** · 13/04/2014, 23h40

Acrobat Ecriture des métadonnées dans un fichier PDF

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
Option Explicit
 
Sub SetMetaDatas()
Dim PDDoc As Object
Dim sFichier As String
Dim sInfo As String
 
    Set PDDoc = CreateObject("AcroExch.PDDoc")
 
    sFichier = ThisWorkbook.Path & "\" & "Test.pdf"
 
    If PDDoc.Open(sFichier) <> "" Then
        sInfo = PDDoc.SetInfo("Title", "essai Titre")
        sInfo = PDDoc.SetInfo("Author", "essai Auteur")
        sInfo = PDDoc.SetInfo("Subject", "essai Sujet")
        sInfo = PDDoc.SetInfo("Keywords", "essai Mots-clés")
        sInfo = PDDoc.SetInfo("Creator", ";)")
        sInfo = PDDoc.SetInfo("Producer", "Zorg")
 
        With PDDoc
            .Save 1, sFichier
            .Close
        End With
    End If
 
    Set PDDoc = Nothing
End Sub

**kiki29** · 14/04/2014, 00h27

Acrobat Lecture des métadonnées d'un fichier PDF

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
Option Explicit
 
Sub GetMetaDatas()
Dim PDDoc As Object
Dim sFichier As String
Dim sInfo As String
 
    Set PDDoc = CreateObject("AcroExch.PDDoc")
 
    sFichier = ThisWorkbook.Path & "\" & "Test.pdf"
 
    If PDDoc.Open(sFichier) <> "" Then
        sInfo = "Titre : " & PDDoc.GetInfo("Title") & vbCrLf
        sInfo = sInfo & "Auteur : " & PDDoc.GetInfo("Author") & vbCrLf
        sInfo = sInfo & "Sujet : " & PDDoc.GetInfo("Subject") & vbCrLf
        sInfo = sInfo & "Mots-clés : " & PDDoc.GetInfo("Keywords") & vbCrLf
        sInfo = sInfo & "Application : " & PDDoc.GetInfo("Creator") & vbCrLf
        sInfo = sInfo & "Outil de conversion PDF : " & PDDoc.GetInfo("Producer") & vbCrLf
        sInfo = sInfo & "Date Création : " & PDDoc.GetInfo("CreationDate") & vbCrLf
        sInfo = sInfo & "Date Modification : " & PDDoc.GetInfo("ModDate")
 
        PDDoc.Close
        MsgBox sInfo
    End If
 
    Set PDDoc = Nothing
End Sub

**kiki29** · 16/04/2014, 16h10

PDFCreator Infos sur version PDFCreator et DLL PdfForge

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
Option Explicit
 
Sub SelFichier()
Dim Fichier As Variant
    ChDir ThisWorkbook.Path & "\"
    Fichier = Application.GetOpenFilename("Fichiers PDF (*.Pdf), *.Pdf", Title:="Sélection du fichier PDF")
    If Fichier = False Then Exit Sub
    VersionPDF (Fichier)
End Sub
 
Private Sub VersionPDF(sNomfichier As String)
Dim pdf As Object, DllInfo As Object
 
    Set pdf = CreateObject("pdfforge.Pdf.Pdf")
    Set DllInfo = CreateObject("pdfforge.DllInfo")
 
    MsgBox "Pdf version : 1." & pdf.PDFVersion(sNomfichier) & vbCrLf & _
            "Dll Version : " & DllInfo.Version & vbCrLf & _
            "Dll Author : " & DllInfo.Author & vbCrLf & _
            "Dll Company : " & DllInfo.Company & vbCrLf & _
            "Dll Copyright : " & DllInfo.Copyright & vbCrLf & _
            "Dll Name : " & DllInfo.Name
 
    MsgBox "Dll License " & DllInfo.License
 
    Set DllInfo = Nothing
    Set pdf = Nothing
End Sub

**kiki29** · 17/04/2014, 01h25

PDFCreator Sauvegarde de pages Web en PDF
Adapté d'un vbs fourni avec l'installation

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
Option Explicit
 
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function QueryPerformanceCounter Lib "kernel32" (x As Currency) As Boolean
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (x As Currency) As Boolean
 
Dim PDFCreator As Object
Dim Dep As Currency, Fin As Currency, Freq As Currency
Const maxTime = 30          ' s
Const sleepTime = 250       ' ms
Const sNomFichier = "Pages Web"
 
Sub SavePagesWeb()
Dim FSO As Object, sDefaultPrinter As String
Dim c As Long, sDossierOut As String
Dim sOut As String
 
    Application.StatusBar = ""
    QueryPerformanceCounter Dep
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set PDFCreator = CreateObject("PDFCreator.clsPDFCreator")
 
    sDossierOut = ThisWorkbook.Path & "\" & "Resultats PDF" & "\"
    If Not FSO.FolderExists(sDossierOut) Then FSO.CreateFolder (sDossierOut)
    Set FSO = Nothing
 
    PDFCreator.cStart "/NoProcessingAtStartup"
    With PDFCreator
        .cOption("UseAutosave") = 1
        .cOption("UseAutosaveDirectory") = 1
        .cOption("AutosaveFormat") = 0
        sDefaultPrinter = .cDefaultPrinter
        .cDefaultPrinter = "PDFCreator"
        .cClearCache
    End With
 
    With PDFCreator
        .cOption("AutosaveDirectory") = sDossierOut
        .cOption("AutosaveFilename") = sNomFichier
 
        'Public Sub cPrintURL(ByVal URL As String, Optional ByVal TimeBetweenLoadAndPrint As Long = 0)
 
        .cPrintURL "http://www.developpez.net/forums/", 1500
        .cPrintURL "http://www.developpez.net/forums/f541/logiciels/microsoft-office/", 1500
        .cPrintURL "http://www.developpez.net/forums/f542/logiciels/microsoft-office/excel/", 1500
        .cPrintURL "http://www.developpez.net/forums/f665/logiciels/microsoft-office/excel/contribuez/", 1500
        .cPrintURL "http://www.developpez.net/forums/d431662/logiciels/microsoft-office/excel/contribuez/excel-word-pdf-adobe-acrobat-pro-pdfcreator/", 1500
 
        Sleep 5000
        .cCombineAll
        .cPrinterStop = False
 
        c = 0
        Do While (.cOutputFilename = "") And (c < (maxTime * 1000 / sleepTime))
            c = c + 1
            Sleep sleepTime
        Loop
        sOut = .cOutputFilename
    End With
 
    With PDFCreator
        .cDefaultPrinter = sDefaultPrinter
        .cClearCache
        Sleep 200
        .cClose
    End With
 
    Set PDFCreator = Nothing
 
    QueryPerformanceCounter Fin
    QueryPerformanceFrequency Freq
    Application.StatusBar = Format(((Fin - Dep) / Freq), "0.00 s")
 
    If sOut = "" Then
        MsgBox "Création du fichier PDF." & vbCrLf & _
                "Une erreur s'est produite : temps écoulé !", vbExclamation + vbSystemModal
    End If
End Sub

**sachadee** · 17/04/2014, 19h45

Bonjour à tous.

kiki29 Bravo pour cette doc sur les fonctions de PDFCreator.
Je pense que je vais en faire une UDF Autoit.

Juste une remarque sur la fonction

Code :

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

AddTextToPDFFile

Il y a apparemment un problème lors de la lecture du fichier de sortie par Adobe Reader (7.0 chez-moi).
Les FONTs ne sont pas reconnus et à la place du texte il y a des petits boules (voir image 1)

image 1:

Nom : testPDF1.JPG
Affichages : 4978
Taille : 23,5 Ko

Nom : testPDF1.JPG
Affichages : 4978
Taille : 23,5 Ko

Alors que si je visualise le même PDF avec IRFANView en ayant installé Ghostscript

Le texte ("Essai Essai Essai Essai Essai") est bien visible (voir image2)

imag 2:

Nom : TESTPDF2.JPG
Affichages : 4809
Taille : 14,2 Ko

Nom : TESTPDF2.JPG
Affichages : 4809
Taille : 14,2 Ko

Une idée pour solutionner ce problème ???

Excel / Word / PDF avec Adobe Acrobat Pro et PDFCreator 1.7.3 (obsolète)

Contribuez

Discussions similaires

Partager

Partager