IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #41
    Expert éminent sénior
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : juin 2006
    Messages : 6 132
    Points : 11 256
    Points
    11 256
    Par défaut
    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
      4  0

  2. #42
    Expert éminent sénior
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : juin 2006
    Messages : 6 132
    Points : 11 256
    Points
    11 256
    Par défaut
    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
      5  1

  3. #43
    Expert éminent sénior
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : juin 2006
    Messages : 6 132
    Points : 11 256
    Points
    11 256
    Par défaut
    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
      4  0

  4. #44
    Expert éminent sénior
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : juin 2006
    Messages : 6 132
    Points : 11 256
    Points
    11 256
    Par défaut
    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.
      3  0

  5. #45
    Expert éminent sénior
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : juin 2006
    Messages : 6 132
    Points : 11 256
    Points
    11 256
    Par défaut
    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
      3  0

  6. #46
    Expert éminent sénior
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : juin 2006
    Messages : 6 132
    Points : 11 256
    Points
    11 256
    Par défaut
    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
      3  0

  7. #47
    Expert éminent
    Avatar de Didier Gonard
    Homme Profil pro
    Formateur Office et développeur VBA en freelance
    Inscrit en
    février 2008
    Messages
    2 805
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Loire Atlantique (Pays de la Loire)

    Informations professionnelles :
    Activité : Formateur Office et développeur VBA en freelance

    Informations forums :
    Inscription : février 2008
    Messages : 2 805
    Points : 6 677
    Points
    6 677
    Par défaut
    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
    Didier Gonard

    Dernier tutoriel :
    Le VBA qu'est ce que c'est ?
    Tutoriels : Voir la liste de mes tutoriels Excel & VBA et mon site pro sur ma Page DVP
    Cours et tutoriels pour apprendre Excel
    N'oubliez pas de mettre : ..quand c'est le cas !
      2  0

  8. #48
    Expert éminent sénior
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : juin 2006
    Messages : 6 132
    Points : 11 256
    Points
    11 256
    Par défaut
    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
      3  0

  9. #49
    Expert éminent sénior
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : juin 2006
    Messages : 6 132
    Points : 11 256
    Points
    11 256
    Par défaut
    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
      3  0

  10. #50
    Expert éminent sénior
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : juin 2006
    Messages : 6 132
    Points : 11 256
    Points
    11 256
    Par défaut
    En PJ un récapitulatif PDF avec les liens aux posts de cette contribution, cela devrait aider.
    Images attachées Images attachées
      7  0

  11. #51
    Expert éminent
    Avatar de Didier Gonard
    Homme Profil pro
    Formateur Office et développeur VBA en freelance
    Inscrit en
    février 2008
    Messages
    2 805
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Loire Atlantique (Pays de la Loire)

    Informations professionnelles :
    Activité : Formateur Office et développeur VBA en freelance

    Informations forums :
    Inscription : février 2008
    Messages : 2 805
    Points : 6 677
    Points
    6 677
    Par défaut
    Excellente idée
    .
    Didier Gonard

    Dernier tutoriel :
    Le VBA qu'est ce que c'est ?
    Tutoriels : Voir la liste de mes tutoriels Excel & VBA et mon site pro sur ma Page DVP
    Cours et tutoriels pour apprendre Excel
    N'oubliez pas de mettre : ..quand c'est le cas !
      1  0

  12. #52
    Expert éminent sénior
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : juin 2006
    Messages : 6 132
    Points : 11 256
    Points
    11 256
    Par défaut
    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
      4  0

  13. #53
    Expert éminent sénior
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : juin 2006
    Messages : 6 132
    Points : 11 256
    Points
    11 256
    Par défaut
    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
      3  0

  14. #54
    Expert éminent sénior
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : juin 2006
    Messages : 6 132
    Points : 11 256
    Points
    11 256
    Par défaut
    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
      3  0

  15. #55
    Membre régulier
    Profil pro
    Inscrit en
    janvier 2007
    Messages
    82
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : janvier 2007
    Messages : 82
    Points : 87
    Points
    87
    Par défaut References - VBAProject
    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
      1  0

  16. #56
    Expert éminent sénior
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : juin 2006
    Messages : 6 132
    Points : 11 256
    Points
    11 256
    Par défaut
    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.
      3  0

  17. #57
    Membre régulier
    Inscrit en
    mars 2010
    Messages
    433
    Détails du profil
    Informations forums :
    Inscription : mars 2010
    Messages : 433
    Points : 102
    Points
    102
    Par défaut problème sous windows server 2008
    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.
      0  0

  18. #58
    Expert éminent Avatar de casefayere
    Homme Profil pro
    RETRAITE
    Inscrit en
    décembre 2006
    Messages
    5 138
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 66
    Localisation : France, Ardennes (Champagne Ardenne)

    Informations professionnelles :
    Activité : RETRAITE
    Secteur : Agroalimentaire - Agriculture

    Informations forums :
    Inscription : décembre 2006
    Messages : 5 138
    Points : 9 551
    Points
    9 551
    Par défaut AcroExch.PDDoc
    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
    Cordialement,
    Dom
    _____________________________________________
    Vous êtes nouveau ? pour baliser votre code, cliquer sur cet exemple : Anomaly
    pensez à cliquer sur si votre problème l'est
    Par contre, il est désagréable de voir une discussion résolue sans message final du demandeur (satisfaction, désarroi, remerciement, conclusion...)
      0  0

  19. #59
    Expert éminent Avatar de casefayere
    Homme Profil pro
    RETRAITE
    Inscrit en
    décembre 2006
    Messages
    5 138
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 66
    Localisation : France, Ardennes (Champagne Ardenne)

    Informations professionnelles :
    Activité : RETRAITE
    Secteur : Agroalimentaire - Agriculture

    Informations forums :
    Inscription : décembre 2006
    Messages : 5 138
    Points : 9 551
    Points
    9 551
    Par défaut
    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
    Cordialement,
    Dom
    _____________________________________________
    Vous êtes nouveau ? pour baliser votre code, cliquer sur cet exemple : Anomaly
    pensez à cliquer sur si votre problème l'est
    Par contre, il est désagréable de voir une discussion résolue sans message final du demandeur (satisfaction, désarroi, remerciement, conclusion...)
      2  0

  20. #60
    Expert éminent sénior
    Avatar de kiki29
    Homme Profil pro
    ex Observeur CGG / Analyste prog.
    Inscrit en
    juin 2006
    Messages
    6 132
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Finistère (Bretagne)

    Informations professionnelles :
    Activité : ex Observeur CGG / Analyste prog.

    Informations forums :
    Inscription : juin 2006
    Messages : 6 132
    Points : 11 256
    Points
    11 256
    Par défaut
    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
      3  0

Discussions similaires

  1. resultat sur un fichier excel,word,pdf
    Par harakatyouness dans le forum C#
    Réponses: 3
    Dernier message: 08/08/2007, 17h45
  2. convertir en pdf avec adobe VBA
    Par sophie.baron dans le forum Général VBA
    Réponses: 1
    Dernier message: 26/03/2007, 15h49
  3. Problème avec adobe acrobat reader
    Par Rabie de OLEP dans le forum Windows XP
    Réponses: 4
    Dernier message: 24/03/2007, 21h50
  4. Problème avec Adobe acrobat reader
    Par castelm dans le forum Autres Logiciels
    Réponses: 4
    Dernier message: 08/03/2007, 22h19
  5. Impression .PDF avec adobe
    Par popo68 dans le forum Access
    Réponses: 2
    Dernier message: 26/02/2007, 13h19

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo