Discussion :

[kiki29]

Lecture des champs d'un formulaire PDF
Testé avec Acrobat Pro 6.0.6 / Distiller 6.0.1 / Reader 10.1.4

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
Option Explicit
 
Sub SelFichier()
Dim Fichier As Variant
    ChDir ThisWorkbook.Path & "\"
    Fichier = Application.GetOpenFilename("Fichiers PDF (*.pdf), *.pdf", Title:="Sélection PDF")
    If Fichier = False Then Exit Sub
    DoEvents
    Lecture_ChampsFormulaire Fichier
End Sub
 
Private Sub Lecture_ChampsFormulaire(ByVal sNomFichier As String)
Dim AVDoc As Object 
Dim Field As Object  
Dim Fields As Object 
Dim AcroForm As Object 
Dim i As Long
 
    Feuil1.Cells.Clear
    With ActiveWindow
        .ScrollRow = 1
        .ScrollColumn = 1
    End With
 
    Application.ScreenUpdating = False
 
    Set AVDoc = CreateObject("AcroExch.AVDoc")
 
    If AVDoc.Open(sNomFichier, "") Then
 
        Set AcroForm = CreateObject("AFormAut.App")
        Set Fields = AcroForm.Fields
 
        With Feuil1
            .Range("A1:D1").Interior.ColorIndex = 40
            .Range("A1") = "Nom du Champ"
            .Range("B1") = "Type"
            .Range("C1") = "Valeur"
            .Range("D1") = "Valeur par Défaut"
        End With
 
        i = 2
        For Each Field In Fields
            With Feuil1
                .Range("A" & i) = Field.Name
                .Range("B" & i) = Field.Type
                .Range("C" & i) = Field.Value
                .Range("D" & i) = Field.DefaultValue
            End With
            i = i + 1
        Next Field
 
        Set Field = Nothing
        Set Fields = Nothing
        Set AcroForm = Nothing
    End If
 
    Set AVDoc = Nothing
 
    Feuil1.Columns("A:D").Columns.AutoFit
    Application.ScreenUpdating = True
 
    KillAcrobat
End Sub
 
Private Sub KillAcrobat()
Dim Rep As Variant
    Rep = Shell("Taskkill /im Acrobat.exe /f", 0)
End Sub

[kiki29]

Ecriture dans les champs d'un formulaire PDF
Testé avec Acrobat Pro 6.0.6 / Distiller 6.0.1 / Reader 10.1.4

Pb de version d'Acrobat trop ancienne si j'en crois le message d'avertissement d'Acrobat Pro.

Bref fourni en l'état, pour les cascadeurs / acrobates..... et les versions plus récentes ?

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
Option Explicit
 
Sub Ecriture_ChampsFormulaire()
Dim AVDoc As Object
Dim PDDoc As Object
Dim JSO As Object
Dim x As Object
Dim sChemin As String
 
    Set AVDoc = CreateObject("AcroExch.AVDoc")
 
    sChemin = ThisWorkbook.Path & "\" & "Test.pdf"
 
    If AVDoc.Open(sChemin, "") Then
 
        Set PDDoc = AVDoc.GetPDDoc
        Set JSO = PDDoc.GetJSObject
 
        ' CheckBox cochée : Yes si PDF US
        Set x = JSO.getField("monsieur")
        x.Value = "Oui"
 
        ' Texte
        Set x = JSO.getField("adresse")
        x.Value = "Essai Adresse"
 
        Set x = JSO.getField("code_postal")
        x.Value = "29520"
 
        Set x = JSO.getField("email")
        x.Value = "xxxxx@yyyyy.fr"
 
        ' CheckBox cochée
        Set x = JSO.getField("celibataire")
        x.Value = "Oui"
 
        Set x = JSO.getField("nom_famille")
        x.Value = "Azerty"
 
        PDDoc.Save 1, ThisWorkbook.Path & "\" & "Essai.pdf"
        PDDoc.Close
 
        Set x= Nothing
        Set JSO = Nothing
        Set PDDoc = Nothing
    End If
 
    Set AVDoc = Nothing
 
    KillAcrobat
End Sub
 
Private Sub KillAcrobat()
Dim Rep As Variant
    Rep = Shell("Taskkill /im Acrobat.exe /f", 0)
End Sub

[kiki29]

Ecriture dans les champs d'un formulaire PDF à partir d'une feuille Excel
Testé avec Acrobat Pro 6.0.6 / Distiller 6.0.1 / Reader 10.1.4

En partant de Lecture des champs d'un formulaire PDF et en supprimant la colonne D : Valeur par Défaut
On inscrit, suivant le Type, en colonne C la valeur souhaitée.
Mêmes restrictions que dans les 2 posts précédents.

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 Ecriture_ChampsFormulaire_Excel()
Dim AVDoc As Object 
Dim sChemin As String
Dim PDDoc As Object 
Dim JSO As Object
Dim X As Object
Dim i As Long
Dim LastRow As Long
 
    LastRow = Feuil2.Range("A" & Rows.Count).End(xlUp).Row
    Set AVDoc = CreateObject("AcroExch.AVDoc")
    sChemin = ThisWorkbook.Path & "\" & "Test.pdf"
 
    If AVDoc.Open(sChemin, "") Then
        Set PDDoc = AVDoc.GetPDDoc
        Set JSO = PDDoc.GetJSObject
 
        For i = 2 To LastRow
            Set X = JSO.getField(CStr(Feuil2.Range("A" & i)))
            X.Value = CStr(Feuil2.Range("C" & i))
        Next i
 
        PDDoc.Save 1, ThisWorkbook.Path & "\" & "Essai Excel.pdf"
        PDDoc.Close
 
        Set X = Nothing
        Set JSO = Nothing
        Set PDDoc = Nothing
    End If
 
    Feuil2.Range("D1").Select
    Set AVDoc = Nothing
    KillAcrobat
End Sub
 
Private Sub KillAcrobat()
Dim Rep As Variant
    Rep = Shell("Taskkill /im Acrobat.exe /f", 0)
End Sub

[kiki29]

Je viens de faire un test avec une version Acrobat Pro 9 et Reader 10, il s'avère que les CheckBoxes conditionnelles ( qui rendent visibles ou non le contenu de certaines parties d'un formulaire ) nécessitent un recliquage pour que cette partie dépendante soit visualisée ou non, mais cela n'est pas le cas de toutes les CheckBoxes (?).
L'écriture dans les champs d'un formulaire PDF à partir d'une feuille Excel s'avère plus de 2 fois plus rapide qu'avec ma version 6.0.6 antédiluvienne.
Sinon la Lecture des champs renvoie bien l'état des champs de tous les types et leur contenu.

[kiki29]

Supprimer les signets d'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
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Option Explicit
 
Sub Supprimer_Signets()
Dim PDDoc As Object
Dim AVDoc As Object
Dim JSO As Object, bmkRoot As Object
Dim vChildren As Variant
Dim i As Long
Dim sIn As String, sOut As String
 
    sIn = ThisWorkbook.Path & "\" & "Test bmk.pdf"
    sOut = ThisWorkbook.Path & "\" & "Test Sans bmk.pdf"
 
    Set AVDoc = CreateObject("AcroExch.AVDoc")
 
    If AVDoc.Open(sIn, "") Then
        Set PDDoc = AVDoc.GetPDDoc
        Set JSO = PDDoc.GetJSObject
        Set bmkRoot = JSO.bookmarkRoot
 
        On Error GoTo Erreur
        vChildren = bmkRoot.Children
        For i = LBound(vChildren) To UBound(vChildren)
            vChildren(i).Remove
        Next i
 
        With PDDoc
            .Save 1, sOut
            .Close
        End With
    End If
 
Retour:
    Set bmkRoot = Nothing
    Set JSO = Nothing
    Set PDDoc = Nothing
    Set AVDoc = Nothing
 
    KillAcrobat
    Exit Sub
 
Erreur:
    If Err.Number <> 438 Then
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
    Resume Retour
End Sub
 
Private Sub KillAcrobat()
Dim Rep As Variant
    Rep = Shell("Taskkill /im Acrobat.exe /f", 0)
End Sub

[kiki29]

PDFCreator Impression via PDFCreator depuis Excel d'un Document Word

Version Basique

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
Option Explicit
 
Sub Excel_Word_PDFCreator()
Dim AppWord As Object
Dim DocWord As Object
Dim sChemin As String
Dim sDefaultPrinter As String
 
    sChemin = ThisWorkbook.Path & "\" & "Test.doc"
 
    Set AppWord = CreateObject("Word.Application")
    Set DocWord = AppWord.Documents.Add(sChemin)
 
    sDefaultPrinter = AppWord.ActivePrinter
    AppWord.ActivePrinter = "PDFCreator"
    DocWord.PrintOut
    AppWord.ActivePrinter = sDefaultPrinter
 
    DocWord.Close
    AppWord.Quit
 
    Set DocWord = Nothing
    Set AppWord = Nothing
End Sub

Version avec choix des chemins Dossiers/Fichiers

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
Option Explicit
 
Sub Excel_Word_PDFCreator()
Dim sFichierInDoc As String
Dim sFichierOutPdf As String
Dim sDossierIn As String
Dim sDossierOut As String
 
    sFichierInDoc = "Test.doc"
    sFichierOutPdf = "Test.pdf"
    sDossierIn = ThisWorkbook.Path & "\"
    sDossierOut = ThisWorkbook.Path & "\"
 
    PdfCreator sFichierInDoc, sFichierOutPdf, sDossierIn, sDossierOut
End Sub
 
Private Sub PdfCreator(sNomFichierDoc As String, sFichierPdf As String, sNomDossierIn As String, sNomDossierOut As String)
Dim JobPDF As Object
Dim AppWord As Object
Dim DocWord As Object
Dim sDefaultPrinter As String
 
    Set AppWord = CreateObject("Word.Application")
    Set DocWord = AppWord.Documents.Add(sNomDossierIn & sNomFichierDoc)
 
    sDefaultPrinter = AppWord.ActivePrinter
    AppWord.ActivePrinter = "PDFCreator"
 
    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") = sNomDossierOut
        .cOption("AutosaveFilename") = sFichierPdf
 
        .cOption("AutosaveFormat") = 0
        .cClearCache
    End With
 
    DocWord.PrintOut
    AppWord.ActivePrinter = sDefaultPrinter
 
    ' Apparition fugitive du message :
    '   Veuillez attendre que Word ait exécuté tous les
    '   travaux d'impression en cours
    DocWord.Close
    AppWord.Quit
 
    Set DocWord = Nothing
    Set AppWord = Nothing
 
    Do Until JobPDF.cCountOfPrintjobs = 1
        DoEvents
    Loop
    JobPDF.cPrinterStop = False
 
    Do Until JobPDF.cCountOfPrintjobs = 0
        DoEvents
    Loop
 
    JobPDF.cClose
    Set JobPDF = Nothing
End Sub

Il peut être judicieux d'avoir ceci sous la main :

Code :

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

1
2
3
4
5
6
7
8
9
Sub Kill_PDFCreator()
Dim RetVal As Long
    RetVal = Shell("Taskkill /im PDFCreator.exe /f", 0)
End Sub
 
Sub Kill_Word()
Dim RetVal As Long
    RetVal = Shell("Taskkill /im WINWORD.exe /f", 0)
End Sub

[Didier Gonard]

Salut kiki 29

Tu devrais en faire un tutoriel (que dis-je, une bible !), la lisibilité de l’ensemble avec des chapitres indexés seraient top, leur mises à jour aussi, en plus l’ensemble le justifie complètement

cordialement,

Didier

[kiki29]

Création Arborescence de Signets de N° de Page et Insertion de Données Excel dans ces Signets
Adapté d'un code initial de J Kamerath

A voir :
Insertion de Données Excel dans les Signets de N° de Page
Supprimer les signets d'un PDF

Créer dans Feuil1 une plage nommée ListeSignets sur A2:Cxy

Page Niveau Nom
01 0 A
02 0 B
05 1 B.1
06 2 B.1.1
07 3 B.1.1.1
09 3 B.1.1.2
10 2 B.1.2
11 2 B.1.3
.....

Résultat final pour l'arborescence de signets
------------------------------------------
A
B
|
+-B.1
| |
| +-B.1.1
| | |
| | +-B.1.1.1
| | |
| | +-B.1.1.2
| |
| +-B.1.2
| |
| +-B.1.3
.....

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
Option Explicit
 
Sub Creer_Arborescence()
Dim sDepart As String
Dim sIntermediaire As String
Dim sFinal As String
 
    ' On part d'un document Test.pdf de x pages, vierge de tout signet.
 
    sDepart = ThisWorkbook.Path & "\" & "Test.pdf"
    sIntermediaire = ThisWorkbook.Path & "\" & "Test bmk.pdf"
    sFinal = ThisWorkbook.Path & "\" & "Test bmk Arbo.pdf"
 
    AjoutDonneesExcel_SignetNumPage sDepart, sIntermediaire
    Arborescence_Signets sIntermediaire, sFinal
 
    Kill sIntermediaire
End Sub
 
Private Sub AjoutDonneesExcel_SignetNumPage(sIn As String, sOut As String)
Dim AVDoc As Object
Dim PDDoc As Object
Dim JSO As Object
Dim sStr As String
Dim i As Long
Dim iNum As Long
Dim LastRow As Long
 
    Set AVDoc = CreateObject("AcroExch.AVDoc")
 
    If AVDoc.Open(sIn, "") Then
        Set PDDoc = AVDoc.GetPDDoc
        Set JSO = PDDoc.GetJSObject
 
        LastRow = Feuil1.[ListeSignets].End(xlDown).Row
        For i = 1 To LastRow
            iNum = Feuil1.[ListeSignets].Cells(i, 1) - 1
            sStr = Feuil1.[ListeSignets].Cells(i, 3)
            JSO.bookmarkRoot.createChild sStr, "this.pageNum=" & iNum, iNum
        Next i
 
        With PDDoc
            .Save 1, sOut
            .Close
        End With
 
        Set JSO = Nothing
        Set PDDoc = Nothing
    End If
 
    Set AVDoc = Nothing
End Sub
 
Private Sub Arborescence_Signets(sIn As String, sOut As String)
Dim PDDoc As Object
Dim AVDoc As Object
Dim JSO As Object, bmkRoot As Object
Dim vChildren As Variant, vChildren1 As Variant
Dim i As Long, NbBmk As Long, XNodes(16) As Long
Dim iLev As Long, XLev(16) As Long
 
    Set AVDoc = CreateObject("AcroExch.AVDoc")
 
    If AVDoc.Open(sIn, "") Then
        Set PDDoc = AVDoc.GetPDDoc
        Set JSO = PDDoc.GetJSObject
        Set bmkRoot = JSO.bookmarkRoot
 
        vChildren = bmkRoot.Children
        NbBmk = UBound(vChildren) - LBound(vChildren) + 1
 
        bmkRoot.createChild "Racine Tempo", "", NbBmk
        vChildren = bmkRoot.Children
        XNodes(0) = NbBmk
 
        For i = 1 To 16
            XLev(i) = 0
        Next i
 
        For i = LBound(vChildren) To UBound(vChildren) - 1
            iLev = Feuil1.[ListeSignets].Cells(i + 1, 2)
            XLev(iLev) = XLev(iLev) + 1
            vChildren(XNodes(iLev)).insertchild vChildren(i), XLev(iLev)
            XNodes(iLev + 1) = i
        Next i
 
        vChildren1 = vChildren(XNodes(0)).Children
        For i = LBound(vChildren1) To UBound(vChildren1)
            bmkRoot.insertchild vChildren1(i), i + 1
        Next i
 
        vChildren(XNodes(0)).Remove
 
        With PDDoc
            .Save 1, sOut
            .Close
        End With
 
        Set bmkRoot = Nothing
        Set JSO = Nothing
        Set PDDoc = Nothing
    End If
 
    Set AVDoc = Nothing
    KillAcrobat
End Sub
 
Private Sub KillAcrobat()
Dim RetVal As Long
    RetVal = Shell("Taskkill /im Acrobat.exe /f", 0)
End Sub

[kiki29]

Acrobat Reader Copier/Coller le texte d'un PDF dans une feuille Excel via des SendKeys
Testé avec Acrobat Reader 11.0

1ere Version

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
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Option Explicit
 
Sub Pdf2Txt()
Dim sFichier As String
Dim sAcro As String
 
    With Feuil1
        .Activate
        .Cells.Clear
        .Range("A1").Select
    End With
 
    sFichier = ThisWorkbook.Path & "\" & "Test.pdf"
    sAcro = "C:\Program Files\Adobe\Reader 11.0\Reader\AcroRD32.exe"
 
    Shell sAcro, vbNormalFocus
 
    SendKeys "^o"
    SendKeys sFichier
    SendKeys "{ENTER}"
 
    SendKeys "^a"
    SendKeys "^c"
    SendKeys "^q"
 
    DoEvents
    With Feuil1
        .Activate
        .Paste
        .Range("B1").Select
    End With
End Sub

2nde Version
Pour remédier au problème intermittent lié aux SenKeys multiples que les DoEvents ne résolvent pas toujours et qui se traduit par une désactivation des NumLock CapsLock ScrollLock PauseLock

Placer dans un module de Classe baptisé clsKeyBoard

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
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)
 
Private Declare Function GetKeyState Lib "User32" (ByVal nVirtKey As Long) As Integer
Private Declare Function MapVirtualKey Lib "User32" Alias "MapVirtualKeyA" (ByVal wCode As Long, _
                                                                            ByVal wMapType As Long) As Long
 
Private Const VK_NUMLOCK = &H90
Private Const VK_SCROLL = &H91
Private Const VK_CAPITAL = &H14
Private Const VK_PAUSE = &H13
 
Private Const KEYEVENTF_EXTENDEDKEY = &H1
Private Const KEYEVENTF_KEYUP = &H2
 
Public Property Get CapsLock() As Boolean
    CapsLock = GetKeyState(VK_CAPITAL) = 1
End Property
 
Public Property Let CapsLock(ByVal Value As Boolean)
    SetKeyState VK_CAPITAL, Value
End Property
 
Public Property Get NumLock() As Boolean
    NumLock = GetKeyState(VK_NUMLOCK) = 1
End Property
 
Public Property Let NumLock(ByVal Value As Boolean)
    SetKeyState VK_NUMLOCK, Value
End Property
 
Public Property Get ScrollLock() As Boolean
    ScrollLock = GetKeyState(VK_SCROLL) = 1
End Property
 
Public Property Let ScrollLock(ByVal Value As Boolean)
    SetKeyState VK_SCROLL, Value
End Property
 
Public Property Get PauseLock() As Boolean
    PauseLock = GetKeyState(VK_PAUSE) = 1
End Property
 
Public Property Let PauseLock(ByVal Value As Boolean)
    SetKeyState VK_PAUSE, Value
End Property
 
Public Sub SetKeyState(ByVal Key As Long, ByVal State As Boolean)
    keybd_event Key, MapVirtualKey(Key, 0), KEYEVENTF_EXTENDEDKEY Or 0, 0
    keybd_event Key, MapVirtualKey(Key, 0), KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP, 0
    If Key = 20 And State = False Then
        keybd_event 16, 0, 0, 0
        keybd_event 16, 0, 2, 0
    End If
End Sub

Placer dans un module Standard

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
Private Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "User32" () As Long
Private Declare Function CloseClipboard Lib "User32" () As Long
 
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Option Explicit
 
Dim ClsClavier As New clsKeyBoard
 
Sub Pdf2Txt()
Dim sFichier As String
Dim sAcro As String
 
    EffacerClipboard
    DoEvents
 
    With Feuil1
        .Activate
        .Cells.Clear
        .Range("A1").Select
    End With
 
    sFichier = ThisWorkbook.Path & "\" & "Test.pdf"
    sAcro = "C:\Program Files\Adobe\Reader 11.0\Reader\AcroRD32.exe"
 
    Clavier
    DoEvents
 
    Shell sAcro, vbNormalFocus
 
    SendKeys "^o"
    SendKeys sFichier
    SendKeys "{ENTER}"
 
    SendKeys "^a"
    SendKeys "^c"
    SendKeys "^q"
 
    DoEvents
    With Feuil1
        .Activate
        .Paste
        .Range("B1").Select
    End With
End Sub
 
Private Sub Clavier()
    ' Etat par défaut du clavier 
    With ClsClavier
        If .NumLock = False Then .NumLock = True
        If .CapsLock = True Then .CapsLock = False
        If .ScrollLock = True Then .ScrollLock = False
        If .PauseLock = True Then .PauseLock = False
    End With
End Sub
 
Private Sub EffacerClipboard()
    OpenClipboard (0&)
    EmptyClipboard
    CloseClipboard
End Sub

[kiki29]

En PJ un récapitulatif PDF avec les liens aux posts de cette contribution, cela devrait aider.

[Didier Gonard]

Excellente idée
.

[kiki29]

PDFCreator Liste des Réglages de PDFCreator

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
Option Explicit
 
Sub Liste_Settings_PDFCreator()
Dim JobPDF As Object
 
    Set JobPDF = CreateObject("PDFCreator.clsPDFCreator")
 
    With JobPDF
        If .cStart("/NoProcessingAtStartup") = False Then
            MsgBox "Initialisation PDFCreator impossible.", vbCritical + _
                    vbOKOnly, "PDFCreator"
            Exit Sub
        End If
 
        Application.ScreenUpdating = False
        Feuil1.Cells.Clear
        Feuil1.Cells(1, 1) = ".cOption(""UseAutosave"")="
        Feuil1.Cells(1, 2) = .cOption("UseAutosave")
 
        Feuil1.Cells(2, 1) = ".cOption(""UseAutosaveDirectory"")="
        Feuil1.Cells(2, 2) = .cOption("UseAutosaveDirectory")
 
        Feuil1.Cells(3, 1) = ".cOption(""AutosaveDirectory"") = "
        Feuil1.Cells(3, 2) = .cOption("AutosaveDirectory")
 
        Feuil1.Cells(4, 1) = ".cOption(""AutosaveFilename"")="
        Feuil1.Cells(4, 2) = .cOption("AutosaveFilename")
 
        Feuil1.Cells(5, 1) = ".cOption(""AutosaveFormat"")="
        Feuil1.Cells(5, 2) = .cOption("AutosaveFormat")
 
        Feuil1.Cells(6, 1) = ".cOption(""UseCreationdate"")="
        Feuil1.Cells(6, 2) = .cOption("UseCreationdate")
 
        Feuil1.Cells(7, 1) = ".cOption(""UseStandardAuthor"")="
        Feuil1.Cells(7, 2) = .cOption("UseStandardAuthor")
 
        Feuil1.Cells(8, 1) = ".cOption(""PDFUseSecurity"")="
        Feuil1.Cells(8, 2) = .cOption("PDFUseSecurity")
 
        Feuil1.Cells(9, 1) = ".cOption(""PDFUserPass"")="
        Feuil1.Cells(9, 2) = .cOption("PDFUserPass")
 
        Feuil1.Cells(10, 1) = ".cOption(""PDFUserPassString"")="
        Feuil1.Cells(10, 2) = .cOption("PDFUserPassString")
 
        Feuil1.Cells(11, 1) = ".cOption(""PDFOwnerPass"")="
        Feuil1.Cells(11, 2) = .cOption("PDFOwnerPass")
 
        Feuil1.Cells(12, 1) = ".cOption(""PDFOwnerPassString"")="
        Feuil1.Cells(12, 2) = .cOption("PDFOwnerPassString")
 
        Feuil1.Cells(13, 1) = ".cOption(""PDFEncryptor"")="
        Feuil1.Cells(13, 2) = .cOption("PDFEncryptor")
 
        Feuil1.Cells(14, 1) = ".cOption(""PDFDisallowCopy"")="
        Feuil1.Cells(14, 2) = .cOption("PDFDisallowCopy")
 
        Feuil1.Cells(15, 1) = ".cOption(""PDFDisallowPrinting"")="
        Feuil1.Cells(15, 2) = .cOption("PDFDisallowPrinting")
 
        Feuil1.Cells(16, 1) = ".cOption(""PDFDisallowModifyContents"")="
        Feuil1.Cells(16, 2) = .cOption("PDFDisallowModifyContents")
 
        Feuil1.Cells(17, 1) = ".cOption(""PDFDisallowModifyAnnotations"")="
        Feuil1.Cells(17, 2) = .cOption("PDFDisallowModifyAnnotations")
 
        Feuil1.Cells(18, 1) = ".cOption(""PrinterTempPath"")="
        Feuil1.Cells(18, 2) = .cOption("PrinterTempPath")
 
    End With
    Application.ScreenUpdating = True
 
    Set JobPDF = Nothing
    Kill_PDFCreator
End Sub
 
Private Sub Kill_PDFCreator()
Dim RetVal As Long
    RetVal = Shell("Taskkill /im PDFCreator.exe /f", 0)
End Sub

[kiki29]

PDFCreator Reset aux valeurs par défaut de PDFCreator

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
Option Explicit
 
Sub Reset_ValeursDefaut()
Dim JobPDF As Object
 
    Set JobPDF = CreateObject("PDFCreator.clsPDFCreator")
    With JobPDF
        If .cStart("/NoProcessingAtStartup") = False Then
            MsgBox "Initialisation PDFCreator impossible.", vbCritical + _
                    vbOKOnly, "PDFCreator"
            Exit Sub
        End If
 
        '   Valeurs par défaut
        .cOption("UseAutosave") = 0
        .cOption("UseAutosaveDirectory") = 1
        .cOption("AutosaveDirectory") = "\"
        .cOption("AutosaveFilename") = ""
 
        '   0,9,10 PDF,1 PNG,2 JPEG,3 BMP,4 PCX
        '   5 TIFF,6 PS,7 EPS,8 TXT
        '   11 PSD,12 PCL,13 RAW,14 SVG
        .cOption("AutosaveFormat") = 0
 
        .cOption("UseCreationdate") = vbNullString
        .cOption("UseStandardAuthor") = 0
        .cOption("PDFUseSecurity") = 0
        .cOption("PDFUserPass") = 0
        .cOption("PDFUserPassString") = vbNullString
        .cOption("PDFOwnerPass") = 1
        .cOption("PDFOwnerPassString") = vbNullString
        .cOption("PDFEncryptor") = 0
        .cOption("PDFDisallowCopy") = 1
        .cOption("PDFDisallowPrinting") = 0
        .cOption("PDFDisallowModifyContents") = 0
        .cOption("PDFDisallowModifyAnnotations") = 0
        .cOption("PrinterTempPath") = "PDFCreator\"
 
        '   Sauvegarde des Valeurs
        .cSaveOptions
    End With
 
    Set JobPDF = Nothing
    Kill_PDFCreator
End Sub
 
Private Sub Kill_PDFCreator()
Dim RetVal As Long
    RetVal = Shell("Taskkill /im PDFCreator.exe /f", 0)
End Sub

PDFCreator Set valeurs PDFCreator
Il va de soit que ces valeurs sont à adapter à votre contexte.

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
Option Explicit
 
Sub SetValeurs()
Dim JobPDF As Object
 
    Set JobPDF = CreateObject("PDFCreator.clsPDFCreator")
    With JobPDF
        If .cStart("/NoProcessingAtStartup") = False Then
            MsgBox "Initialisation PDFCreator impossible.", vbCritical + _
                    vbOKOnly, "PDFCreator"
            Exit Sub
        End If
 
        '   Valeurs
        .cOption("UseAutosave") = 1
        .cOption("UseAutosaveDirectory") = 1
        .cOption("AutosaveDirectory") = "C:\Documents and Settings\Philippe\Mes documents\PdfOut\"
        .cOption("AutosaveFilename") = "<Title>"
 
        '   0,9,10 PDF,1 PNG,2 JPEG,3 BMP,4 PCX
        '   5 TIFF,6 PS,7 EPS,8 TXT
        '   11 PSD,12 PCL,13 RAW,14 SVG
        .cOption("AutosaveFormat") = 0
 
        .cOption("UseCreationdate") = vbNullString
        .cOption("UseStandardAuthor") = 0
        .cOption("PDFUseSecurity") = 0
        .cOption("PDFUserPass") = 0
        .cOption("PDFUserPassString") = vbNullString
        .cOption("PDFOwnerPass") = 1
        .cOption("PDFOwnerPassString") = vbNullString
        .cOption("PDFEncryptor") = 0
        .cOption("PDFDisallowCopy") = 1
        .cOption("PDFDisallowPrinting") = 0
        .cOption("PDFDisallowModifyContents") = 0
        .cOption("PDFDisallowModifyAnnotations") = 0
        .cOption("PrinterTempPath") = "C:\Temp\PdfCreator\"
 
        '   Sauvegarde des Valeurs
        .cSaveOptions
    End With
    Set JobPDF = Nothing
 
    Kill_PDFCreator
End Sub
 
Private Sub Kill_PDFCreator()
Dim RetVal As Long
    RetVal = Shell("Taskkill /im PDFCreator.exe /f", 0)
End Sub

[kiki29]

PDFCreator Impression de certaines Feuilles d'un classeur via un tableau dans un seul Pdf résultant

Pour Acrobat Pro voir ici , en bas du Post#1.

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
Option Explicit
 
Sub TstPdfCreator_Multi()
Dim JobPDF As Object
Dim sNomPDF As String
Dim sCheminPDF As String
Dim Ar() As String, Cpt As Long, i As Long
 
    Application.ScreenUpdating = False
    sNomPDF = "Essai_Muiti.pdf"
    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
 
        '   0,9,10 PDF,1 PNG,2 JPEG,3 BMP,4 PCX
        '   5 TIFF,6 PS,7 EPS,8 TXT
        '   11 PSD,12 PCL,13 RAW,14 SVG
        .cOption("AutosaveFormat") = 0
 
        .cClearCache
    End With
 
	' Pour n'imprimer que certaines feuilles du classeur
    Cpt = 0
    For i = 1 To ThisWorkbook.Sheets.Count
        If Left$(ThisWorkbook.Sheets(i).Name, 5) = "ABCDE" Then
            ReDim Preserve Ar(Cpt)
            Ar(Cpt) = Sheets(i).Name
            Cpt = Cpt + 1
        End If
    Next i
    If Cpt = 0 Then
        Set JobPDF = Nothing
        Application.ScreenUpdating = True
        Exit Sub
    End If
 
    Sheets(Ar).Select
    Sheets(Ar).PrintOut copies:=1, ActivePrinter:="PDFCreator"
 
	'	Pour imprimer tout le classeur
    'ActiveWorkbook.PrintOut copies:=1, ActivePrinter:="PDFCreator"
 
    '   Fichier dans la file d'attente
    Do Until JobPDF.cCountOfPrintjobs = 1
        DoEvents
    Loop
    '   Démarrage Imprimante
    JobPDF.cPrinterStop = False
 
    '   Attendre que la file d'attente soit vide
    Do Until JobPDF.cCountOfPrintjobs = 0
        DoEvents
    Loop
 
    JobPDF.cClose
    Set JobPDF = Nothing
    Erase Ar
 
    ' Resélectionner une feuille seulement
    Worksheets(1).Select
    Application.ScreenUpdating = True
 
    KillPDFCreator
End Sub
 
'	Toujours utile !
Private Sub KillPDFCreator()
Dim RetVal As Long
    RetVal = Shell("Taskkill /im PDFCreator.exe /f", 0)
End Sub

[vpovpo]

Pour faire

Code :

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

Set AcroXApp = CreateObject("AcroExch.App")

il faut ajouter une librairie au projet VBA Excel ? Parce qu'il dit "ActiveX component can't create object".
Merci

[kiki29]

Salut, en fait pour exécuter ces bouts de code il faut :
PDFCreator quand cela est indiqué dans l'en-tête du Post
sinon Adobe Acrobat Pro ( payant ) et pas seulement le Reader.

[jjacques68]

bonjour,

j'utilise la partie de code que vous indiquez dans le chapitre #8 de cette discussion sur des postes équipés de Windows 7 pro.
J'utilise ce code VBA dans une procédure sous ACCESS.
Aucun problème pour le fonctionnement.

Cependant sous Windows server 2008,
cette ligne de code pause problème :

Code :

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

Set Pdf = CreateObject("pdfforge.pdf.pdf")

il me dit erreur 429 un composant activeX ne peut pas créer l'objet.
Alors que pdfcreator est bien installé sur le serveur.
Et les référence en VBA sont bien faites.

Avez vous une idée ?

Merci d'avance !!!

jjacques68.

[casefayere]

Bonjour ou bonsoir à tou(te)s, kiki29

J'ai eu enfin besoin de ton excellente contribution, Philippe, surtout pour adapter ton post #3, mais j'ai un message d'erreur à cette ligne :

Code :

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

    Set PDDoc = CreateObject("AcroExch.PDDoc")

erreur 429, un composant ActiveX ne peut pas créer d'objet.

j'ai pourtant bien coché la référence "Microsoft Forms 2.0 Object Library",

Dans l'espoir d'obtenir une réponse,

Bonne continuation et encore bravo

[casefayere]

Bonjour,
Je reviens sur ce que je viens d'écrire sur mon dernier post car je n'ouvre pas assez les yeux quant à l'utilisation de matériel "Pro", je m'en excuse mais je tenais à écrire malgré tout que cette contribution adapté avec d'autres propositions publiées, m'a permis de finaliser mon programme en reprenant les "SendKeys" proposés par kiki29, et, bien sur, les procédures relatives "clsKeyBoard", "Clavier" et "EffacerClipboard". Voici le code principal qui fonctionne très bien :

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
Dim stAppName As String, NomDeLafenetre As String
Application.ScreenUpdating = False
rep = InputBox("Mon message", "mon titre", "mon ducument.pdf")
Trouve "C:\Users\" & nomdepart 'procédure avec "FSo", nomdepart étant le nom de l'"Users"
stAppName = ch_reader
ThisWorkbook.FollowHyperlink stAppName 'Charger la fenetre Acrobat Reader
    NomDeLafenetre = rep & " - Adobe Reader"
    AppActivate NomDeLafenetre 'activer la fenetre Acrobat Reader
    Application.Wait (Now + TimeValue("0:00:01"))
    SendKeys "^{a}" 'Sélectionner tout avec CTRL-A
    SendKeys "^{c}" 'Copier avec CTRL-C
    Clavier 'pour annuler les effets néfastes de SendKeys
    AppActivate "Microsoft Excel" 'Redonner le focus à Excel
 
    Application.Wait (Now + TimeValue("0:00:01"))
    With Feuil1
        .Activate
        .Paste
        .Range("A2").Select
    End With
    AppActivate NomDeLafenetre
    SendKeys "^{q}" 'Quitter Acrobat Reader
    Clavier 'pour annuler les effets néfastes de SendKeys
    Application.ScreenUpdating = True
 
    DoEvents

et ma procédure "Trouve"

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
Sub Trouve(Chemin)
    Dim fso, ListR, sRep, ListF, Rep1, LesReps, fich
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ListR = fso.GetFolder(Chemin)
    Set sRep = ListR.SubFolders
    For Each Rep1 In sRep
        LesReps = Rep1.Name
        If LesReps = "Desktop" Then
          Set ListF = Rep1
          For Each fich In ListF.Files
            If fich.Name = rep Then
              ch_reader = fich.Path
              Exit For
            End If
        Next
      End If
    Next
End Sub

Merci encore, bonne journée et bonne continuation à toutes et tous

[kiki29]

PDFCreator Liste des valeurs de PDFCreator : suite du Post 53 avec Options Cachées

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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
Option Explicit
 
Sub Liste_Valeurs_PDFCreator()
Dim JobPDF As Object
 
    Set JobPDF = CreateObject("PDFCreator.clsPDFCreator")
 
    With JobPDF
        If .cStart("/NoProcessingAtStartup") = False Then
            MsgBox "Initialisation PDFCreator impossible.", vbCritical + _
                    vbOKOnly, "PDFCreator"
            Exit Sub
        End If
 
        Application.ScreenUpdating = False
        Feuil1.Cells.Clear
 
        Feuil1.Cells(1, 1) = ".cOption(""AutosaveDirectory"") = "
        Feuil1.Cells(1, 2) = .coption("AutosaveDirectory")
 
        Feuil1.Cells(2, 1) = ".cOption(""AutosaveFilename"")="
        Feuil1.Cells(2, 2) = .coption("AutosaveFilename")
 
        Feuil1.Cells(3, 1) = ".cOption(""AutosaveFormat"")="
        Feuil1.Cells(3, 2) = .coption("AutosaveFormat")
 
        Feuil1.Cells(4, 1) = ".cOption(""AutosaveStartStandardProgram"")="
        Feuil1.Cells(4, 2) = .coption("AutosaveStartStandardProgram")
 
        Feuil1.Cells(5, 1) = ".cOption(""PDFDisallowCopy"")="
        Feuil1.Cells(5, 2) = .coption("PDFDisallowCopy")
 
        Feuil1.Cells(6, 1) = ".cOption(""PDFDisallowModifyAnnotations"")="
        Feuil1.Cells(6, 2) = .coption("PDFDisallowModifyAnnotations")
 
        Feuil1.Cells(7, 1) = ".cOption(""PDFDisallowModifyContents"")="
        Feuil1.Cells(7, 2) = .coption("PDFDisallowModifyContents")
 
        Feuil1.Cells(8, 1) = ".cOption(""PDFDisallowPrinting"")="
        Feuil1.Cells(8, 2) = .coption("PDFDisallowPrinting")
 
        Feuil1.Cells(9, 1) = ".cOption(""PDFEncryptor"")="
        Feuil1.Cells(9, 2) = .coption("PDFEncryptor")
 
        Feuil1.Cells(10, 1) = ".cOption(""PDFOwnerPass"")="
        Feuil1.Cells(10, 2) = .coption("PDFOwnerPass")
 
        Feuil1.Cells(11, 1) = ".cOption(""PDFOwnerPassString"")="
        Feuil1.Cells(11, 2) = .coption("PDFOwnerPassString")
 
        Feuil1.Cells(12, 1) = ".cOption(""PDFUserPass"")="
        Feuil1.Cells(12, 2) = .coption("PDFUserPass")
 
        Feuil1.Cells(13, 1) = ".cOption(""PDFUserPassString"")="
        Feuil1.Cells(13, 2) = .coption("PDFUserPassString")
 
        Feuil1.Cells(14, 1) = ".cOption(""PDFUseSecurity"")="
        Feuil1.Cells(14, 2) = .coption("PDFUseSecurity")
 
        Feuil1.Cells(15, 1) = ".cOption(""PrinterTempPath"")="
        Feuil1.Cells(15, 2) = .coption("PrinterTempPath")
 
        Feuil1.Cells(16, 1) = ".cOption(""UseAutosave"")="
        Feuil1.Cells(16, 2) = .coption("UseAutosave")
 
        Feuil1.Cells(17, 1) = ".cOption(""UseAutosaveDirectory"")="
        Feuil1.Cells(17, 2) = .coption("UseAutosaveDirectory")
 
        Feuil1.Cells(18, 1) = ".cOption(""UseCreationdate"")="
        Feuil1.Cells(18, 2) = .coption("UseCreationdate")
 
        Feuil1.Cells(19, 1) = ".cOption(""UseStandardAuthor"")="
        Feuil1.Cells(19, 2) = .coption("UseStandardAuthor")
 
        '   Options Cachées
 
        Feuil1.Cells(20, 1) = ".cOption(""DisableEmail"")="
        Feuil1.Cells(20, 2) = .coption("DisableEmail")
 
        Feuil1.Cells(21, 1) = ".cOption(""DisableUpdateCheck"")="
        Feuil1.Cells(21, 2) = .coption("DisableUpdateCheck")
 
        Feuil1.Cells(22, 1) = ".cOption(""PDFCompressionColorCompression"")="
        Feuil1.Cells(22, 2) = .coption("PDFCompressionColorCompression")
 
        Feuil1.Cells(23, 1) = ".coption(""PDFCompressionColorCompressionJPEGMaximumFactor"")="
        Feuil1.Cells(23, 2) = .coption("PDFCompressionColorCompressionJPEGMaximumFactor")
 
        Feuil1.Cells(24, 1) = ".coption(""PDFCompressionColorCompressionJPEGHighFactor"")="
        Feuil1.Cells(24, 2) = .coption("PDFCompressionColorCompressionJPEGHighFactor")
 
        Feuil1.Cells(25, 1) = ".coption(""PDFCompressionColorCompressionJPEGMediumFactor"")="
        Feuil1.Cells(25, 2) = .coption("PDFCompressionColorCompressionJPEGMediumFactor")
 
        Feuil1.Cells(26, 1) = ".coption(""PDFCompressionColorCompressionJPEGLowFactor"")="
        Feuil1.Cells(26, 2) = .coption("PDFCompressionColorCompressionJPEGLowFactor")
 
        Feuil1.Cells(27, 1) = ".coption(""PDFCompressionColorCompressionJPEGMinimumFactor"")="
        Feuil1.Cells(27, 2) = .coption("PDFCompressionColorCompressionJPEGMinimumFactor")
 
        Feuil1.Cells(28, 1) = ".cOption(""PDFCompressionGreyCompression"")="
        Feuil1.Cells(28, 2) = .coption("PDFCompressionGreyCompression")
 
        Feuil1.Cells(29, 1) = ".coption(""PDFCompressionGreyCompressionJPEGMaximumFactor"")="
        Feuil1.Cells(29, 2) = .coption("PDFCompressionGreyCompressionJPEGMaximumFactor")
 
        Feuil1.Cells(30, 1) = ".coption(""PDFCompressionGreyCompressionJPEGHighFactor"")="
        Feuil1.Cells(30, 2) = .coption("PDFCompressionGreyCompressionJPEGHighFactor")
 
        Feuil1.Cells(31, 1) = ".coption(""PDFCompressionGreyCompressionJPEGMediumFactor"")="
        Feuil1.Cells(31, 2) = .coption("PDFCompressionGreyCompressionJPEGMediumFactor")
 
        Feuil1.Cells(32, 1) = ".coption(""PDFCompressionGreyCompressionJPEGLowFactor"")="
        Feuil1.Cells(32, 2) = .coption("PDFCompressionGreyCompressionJPEGLowFactor")
 
        Feuil1.Cells(33, 1) = ".coption(""PDFCompressionGreyCompressionJPEGMinimumFactor"")="
        Feuil1.Cells(33, 2) = .coption("PDFCompressionGreyCompressionJPEGMinimumFactor")
 
        Feuil1.Cells(34, 1) = ".cOption(""PDFOwnerPasswordString"")="
        Feuil1.Cells(34, 2) = .coption("PDFOwnerPasswordString ")
 
        Feuil1.Cells(35, 1) = ".cOption(""PDFUserPasswordString"")="
        Feuil1.Cells(35, 2) = .coption("PDFUserPasswordString ")
 
        Feuil1.Cells(36, 1) = ".cOption(""RemoveAllKnownFileExtensions"")="
        Feuil1.Cells(36, 2) = .coption("RemoveAllKnownFileExtensions")
 
        Feuil1.Cells(37, 1) = ".cOption(""StandardCreationdate"")="
        Feuil1.Cells(37, 2) = .coption("StandardCreationdate")
 
        Feuil1.Cells(38, 1) = ".cOption(""StandardDateformat"")="
        Feuil1.Cells(38, 2) = .coption("StandardDateformat")
 
        Feuil1.Cells(39, 1) = ".cOption(""StandardKeywords"")="
        Feuil1.Cells(39, 2) = .coption("StandardKeywords")
 
        Feuil1.Cells(40, 1) = ".cOption(""StandardModifydate"")="
        Feuil1.Cells(40, 2) = .coption("StandardModifydate")
 
        Feuil1.Cells(41, 1) = ".cOption(""StandardSubject"")="
        Feuil1.Cells(41, 2) = .coption("StandardSubject")
 
        Feuil1.Cells(42, 1) = ".cOption(""StandardTitle"")="
        Feuil1.Cells(42, 2) = .coption("StandardTitle")
 
        Feuil1.Cells(43, 1) = ".cOption(""ClientComputerResolveIPAddress"")="
        Feuil1.Cells(43, 2) = .coption("ClientComputerResolveIPAddress")
 
        Feuil1.Range("A20:A43").Interior.ColorIndex = 40
 
        Feuil1.Cells(1, 3).Select
        Application.ScreenUpdating = True
 
    End With
 
    Set JobPDF = Nothing
    Kill_PDFCreator
End Sub
 
Private Sub Kill_PDFCreator()
Dim RetVal As Long
    RetVal = Shell("Taskkill /im PDFCreator.exe /f", 0)
End Sub