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

Contribuez Discussion :

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


Sujet :

Contribuez

  1. #1
    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 276
    Points
    11 276
    Par défaut Excel / Word / PDF avec Adobe Acrobat Pro et PDFCreator 1.7.3 (obsolète)
    Le but de ce code est de pouvoir générer un fichier Pdf via Distiller en nommant le fichier comme on l'entend,
    et en le sauvant dans un dossier de son choix : choix autre que celui assigné par défaut lors de l'installation de la suite Acrobat.

    Testé sous Excel XP ( 2002 SP3 ) / Acrobat 6.0.6 Pro / Distiller 6.0.1
    Early Binding
    sous VBE Menu Outils | Références cocher Acrobat Distiller


    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
     
    Option Explicit
    Dim sNomPortReseau As String
     
    Sub Tst_Adobe_PDF_03()
    Dim sNomFichierPS As String
    Dim sNomFichierPDF As String
    Dim sNomFichierLOG As String
    Dim PDFDist As PdfDistiller
    Dim PrinterDefault As String
     
        '   Sur un PC "Personnel" : a priori choix libre du Nom
        '   et de l'emplacement du fichier de sortie, on est logué en 
        '   Administrateur sur son PC
        '
        '   Sur un PC "Entreprise" :
        '   Il faut être logué en Administrateur ou en
        '   Avoir les droits pour utiliser Distiller
        '   Les chemins PS PDF LOG devront être de la forme :
        '       "C:\Documents and Settings\UserName\.....\....."
     
        '   Si l'on a plusieurs imprimantes il faut :
        '       Sélectionner l'imprimante virtuelle Adobe PDF tout en conservant
        '           trace de l'imprimante utilisée par défaut
        '   Le N° de port réseau NeXY varie suivant le PC sur lequel la macro tourne
     
        PrinterDefault = Application.ActivePrinter
        If Imprimante_AdobePDF Then
            Application.ActivePrinter = sNomPortReseau
        Else
            MsgBox "Pas d'imprimante Adobe PDF sur NeXY ", vbOKOnly+vbCritical, "Achtung"
            Exit Sub
        End If
     
        ' Ici le cas d'un PC "Personnel"
        sNomFichierPS = ThisWorkbook.Path & "\" & "Essai_AdobbePDF.ps"
        sNomFichierPDF = ThisWorkbook.Path & "\" & "Essai_AdobbePDF.pdf"
        sNomFichierLOG = ThisWorkbook.Path & "\" & "Essai_AdobbePDF.log"
     
        '   Impression d'une zone nommée
        ActiveSheet.Range("Zone").PrintOut Copies:=1, Preview:=False, _
                                           ActivePrinter:=sNomPortReseau , PrintToFile:=True, _
                                           Collate:=True, PrToFilename:=sNomFichierPS
     
        Set PDFDist = New PdfDistiller
        PDFDist.FileToPDF sNomFichierPS, sNomFichierPDF, ""
        Set PDFDist = Nothing
     
        Kill sNomFichierPS
        Kill sNomFichierLOG
     
        Application.ActivePrinter = PrinterDefault
    End Sub
     
    Private Function Imprimante_AdobePDF() As Boolean
    Dim i As Long
        ' 11 imprimantes réseau
        Imprimante_AdobePDF = False
        For i = 0 To 10
            If i < 10 Then
                sNomPortReseau = "Adobe PDF sur Ne0" & i & ":"
            Else
                sNomPortReseau = "Adobe PDF sur Ne" & i & ":"
            End If
            On Error Resume Next
            Application.ActivePrinter = sNomPortReseau
            If ActivePrinter = sNomPortReseau Then
                Imprimante_AdobePDF = True
                Exit For
            End If
        Next i
    End Function
    Dans une configuration d'Entreprise avec de multiples utilisateurs et les droits attenants il peut être nécessaire de connaitre son nom de login ( qui n'a rien à voir avec Application.UserName de VBA )
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    ...
    Dim sUserName As String
        sUserName = Environ("USERNAME")
    ...
    Ou si l'on préfère connaître le chemin "C:\Documents and Settings\UserName"
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    ...
    Dim sUserProfile as string
        sUserProfile = Environ("USERPROFILE")
    ...
    Dans ce cas l'exemple ci-dessus deviendra qqch comme :
    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
     
    Dim sNomPortReseau As String
     
    Sub Tst_Adobe_PDF()
    Dim sNomFichierPS As String
    Dim sNomFichierPDF As String
    Dim sNomFichierLOG As String
    Dim PDFDist As PdfDistiller
    Dim PrinterDefault As String
    Dim sUserProfile As String
     
        sUserProfile = Environ("USERPROFILE")
     
        PrinterDefault = Application.ActivePrinter
        If Imprimante_AdobePDF Then
            Application.ActivePrinter = sNomPortReseau
        Else
            MsgBox "Pas d'imprimante Adobe PDF sur NeXY ", vbOKOnly+vbCritical, "Achtung"
            Exit Sub
        End If
     
        ' Ici le cas d'un PC "Entreprise"
        sNomFichierPS = sUserProfile & "\" & "Essai_AdobbePDF.ps"
        sNomFichierPDF = sUserProfile & "\" & "Essai_AdobbePDF.pdf"
        sNomFichierLOG = sUserProfile & "\" & "Essai_AdobbePDF.log"
     
        ActiveSheet.Range("Zone").PrintOut Copies:=1, Preview:=False, _
                                           ActivePrinter:=sNomPortReseau , PrintToFile:=True, _
                                           Collate:=True, PrToFilename:=sNomFichierPS
     
        Set PDFDist = New PdfDistiller
        PDFDist.FileToPDF sNomFichierPS, sNomFichierPDF, ""
        Set PDFDist = Nothing
     
        Kill sNomFichierPS
        Kill sNomFichierLOG
     
        Application.ActivePrinter = PrinterDefault
    End Sub
     
    Private Function Imprimante_AdobePDF() As Boolean
    Dim i As Long
        ' 11 imprimantes réseau
        Imprimante_AdobePDF = False
        For i = 0 To 10
            If i < 10 Then
                sNomPortReseau = "Adobe PDF sur Ne0" & i & ":"
            Else
                sNomPortReseau = "Adobe PDF sur Ne" & i & ":"
            End If
            On Error Resume Next
            Application.ActivePrinter = sNomPortReseau
            If ActivePrinter = sNomPortReseau Then
                Imprimante_AdobePDF = True
                Exit For
            End If
        Next i
    End Function
    Impression de certaines Feuilles d'un classeur via un tableau dans un seul Pdf résultant
    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
    Dim sNomPortReseau As String
     
    Sub Tst4()
    Dim sNomFichierPS As String
    Dim sNomFichierPDF As String
    Dim sNomFichierLog As String
    Dim PDFDist As PdfDistiller, PrinterDefault As String
    Dim i As Long, Cpt As Long
    Dim Ar() As String
     
        sNomFichierPS = ThisWorkbook.Path & "\" & "Tableau.ps"
        sNomFichierPDF = ThisWorkbook.Path & "\" & "Tableau.pdf"
        sNomFichierLog = ThisWorkbook.Path & "\" & "Tableau.log"
     
        Cpt = 0
        For i = 1 To ThisWorkbook.Sheets.Count
            If Left(Sheets(i).Name, 2) = "RF" Or Left(Sheets(i).Name, 2) = "RC" Then
                ReDim Preserve Ar(Cpt)
                Ar(Cpt) = Sheets(i).Name
                Cpt = Cpt + 1
            End If
        Next i
        If Cpt = 0 Then Exit Sub
     
        PrinterDefault = Application.ActivePrinter
        If Imprimante_AdobePDF Then
            Application.ActivePrinter = sNomPortReseau
        Else
            MsgBox "Pas d'imprimante Adobe PDF sur NeXY ", vbOKOnly + vbCritical, "Achtung"
            Exit Sub
        End If
     
        Application.ScreenUpdating = False
        Sheets(Ar).PrintOut copies:=1, Preview:=False, _
                            ActivePrinter:=sNomPortReseau, PrintToFile:=True, _
                            PrToFileName:=sNomFichierPS
     
        Set PDFDist = New PdfDistiller
        PDFDist.FileToPDF sNomFichierPS, sNomFichierPDF, ""
        Set PDFDist = Nothing
     
        Kill sNomFichierPS
        Kill sNomFichierLog
     
        Application.ScreenUpdating = True
        Application.ActivePrinter = PrinterDefault
        Sheets("Feuil1").Select
    End Sub
     
    Private Function Imprimante_AdobePDF() As Boolean
    Dim i As Long
        ' 11 imprimantes réseau
        Imprimante_AdobePDF = False
        For i = 0 To 10
            If i < 10 Then
                sNomPortReseau = "Adobe PDF sur Ne0" & i & ":"
            Else
                sNomPortReseau = "Adobe PDF sur Ne" & i & ":"
            End If
            On Error Resume Next
            Application.ActivePrinter = sNomPortReseau
            If ActivePrinter = sNomPortReseau Then
                Imprimante_AdobePDF = True
                Exit For
            End If
        Next i
    End Function
    en Late Binding ( sans référence à cocher )
    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
    Option Explicit
    
    Dim sNomPortReseau As String
    
    Sub Tst_Adobe_PDF()
    Dim sNomFichierPS As String
    Dim sNomFichierPDF As String
    Dim sNomFichierLOG As String
    Dim PDFDist As Object
    Dim PrinterDefault As String
    Dim sUserProfile As String
     
        sUserProfile = Environ("USERPROFILE")
        
        PrinterDefault = Application.ActivePrinter
        If Imprimante_AdobePDF Then
            Application.ActivePrinter = sNomPortReseau
        Else
            MsgBox "Pas d'imprimante Adobe PDF sur NeXY ", vbOKOnly + vbCritical, "Achtung"
            Exit Sub
        End If
       
        sNomFichierPS = sUserProfile & "\" & "LateBinding_AdobePDF.ps"
        sNomFichierPDF = sUserProfile & "\" & "LateBinding_AdobePDF.pdf"
        sNomFichierLOG = sUserProfile & "\" & "LateBinding_AdobePDF.log"
     
        ActiveSheet.Range("Zone").PrintOut Copies:=1, Preview:=False, _
                                           ActivePrinter:=sNomPortReseau, PrintToFile:=True, _
                                           Collate:=True, PrToFilename:=sNomFichierPS
     
        Set PDFDist = CreateObject("PdfDistiller.PdfDistiller")
        PDFDist.FileToPDF sNomFichierPS, sNomFichierPDF, ""
        Set PDFDist = Nothing
     
        Kill sNomFichierPS
        Kill sNomFichierLOG
     
        Application.ActivePrinter = PrinterDefault
    End Sub
    
    Private Function Imprimante_AdobePDF() As Boolean
    Dim i As Long
        Imprimante_AdobePDF = False
        For i = 0 To 10
            If i < 10 Then
                sNomPortReseau = "Adobe PDF sur Ne0" & i & ":"
            Else
                sNomPortReseau = "Adobe PDF sur Ne" & i & ":"
            End If
            On Error Resume Next
            Application.ActivePrinter = sNomPortReseau
            If ActivePrinter = sNomPortReseau Then
                Imprimante_AdobePDF = True
                Exit For
            End If
        Next i
    End Function
    Sous Excel 2007, moyennant le téléchargement d'un complément qui rend possible l'enregistrement en Pdf (ou Xps)
    http://www.microsoft.com/downloads/d...displaylang=fr
    Le SP2 intègre ce complément
    Impression de certaines Feuilles d'un classeur via un tableau dans un seul Pdf résultant
    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
     
    Sub Tst_2007()
    Dim sNomFichierPDF As String
    Dim i As Long, Cpt As Long
    Dim Ar() As String
     
        sNomFichierPDF = ThisWorkbook.Path & "\" & "Tableau2007.pdf"
     
        Cpt = 0
        For i = 1 To ThisWorkbook.Sheets.Count
            If Left(Sheets(i).Name, 2) = "RF" Or Left(Sheets(i).Name, 2) = "RC" Then
                ReDim Preserve Ar(Cpt)
                Ar(Cpt) = Sheets(i).Name
                Cpt = Cpt + 1
            End If
        Next i
        If Cpt = 0 Then Exit Sub
     
        Application.ScreenUpdating = False
        Sheets(Ar).Select
     
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sNomFichierPDF _
            , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
            :=False, OpenAfterPublish:=False
     
        Sheets("Feuil1").Select
        Application.ScreenUpdating = True
    End Sub
      9  0

  2. #2
    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 276
    Points
    11 276
    Par défaut
    Sauvegarder un fichier PDF au format TEXTE via VBA Excel

    Ajouter un bouton et l'affecter à la procédure SelectionFichier
    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
     
    Option Explicit
     
    '    com.adobe.acrobat.accesstext           txt
    '    com.adobe.acrobat.doc                  doc
    '    com.adobe.acrobat.eps                  eps
    '    com.adobe.acrobat.html-3-20            html, htm
    '    com.adobe.acrobat.html-4-01-css-1-00   html, htm
    '    com.adobe.acrobat.jp2k                 jpf, jpx, jp2, j2k, j2c, jpc
    '    com.adobe.acrobat.jpeg                 jpeg, jpg, jpe
    '    com.adobe.acrobat.plain-text           txt
    '    com.adobe.acrobat.png                  png
    '    com.adobe.acrobat.ps                   ps
    '    com.adobe.acrobat.RTF                  rft
    '    com.adobe.acrobat.tiff                 tiff, tif
    '    com.adobe.acrobat.xml-1-00             xml
     
    Sub SelectionFichier()
    Dim FD As FileDialog
     
        Set FD = Application.FileDialog(msoFileDialogFilePicker)
        With FD
            .InitialFileName = ThisWorkbook.Path
            .AllowMultiSelect = False
            .Filters.Clear
            .Filters.Add "PDF", "*.pdf", 1
            .ButtonName = "Ouvrir fichier"
            .Title = "Sélectionner un fichier PDF"
        End With
     
        If FD.Show = True Then Lire FD.SelectedItems(1)
     
        Set FD = Nothing
    End Sub
     
    Private Sub Lire(sFichier As String)
    Dim AcroXApp As Object
    Dim AcroXAVDoc As Object
    Dim AcroXPDDoc As Object
    Dim JSO As Object
    Dim sCheminPDF As String, sChemin As String
     
        Set AcroXApp = CreateObject("AcroExch.App")
        AcroXApp.Hide
     
        sCheminPDF = sFichier
        sChemin = ThisWorkbook.Path & "\" & "Essai.txt"
     
        Set AcroXAVDoc = CreateObject("AcroExch.AVDoc")
        AcroXAVDoc.Open sCheminPDF, "Acrobat"
        AcroXAVDoc.BringToFront
     
        Set AcroXPDDoc = AcroXAVDoc.GetPDDoc
        Set JSO = AcroXPDDoc.GetJSObject
     
        JSO.SaveAs sChemin, "com.adobe.acrobat.accesstext"
     
        AcroXAVDoc.Close False
        AcroXApp.Exit
     
        Set JSO = Nothing
        Set AcroXPDDoc = Nothing
        Set AcroXAVDoc = Nothing
        Set AcroXApp = Nothing
    End Sub
      8  0

  3. #3
    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 276
    Points
    11 276
    Par défaut
    Un autre exemple pour récupérer le texte d'un fichier PDF dans une feuille Excel
    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
    Option Explicit
    
    Sub SelectionFichier2()
    Dim FD As FileDialog
    
        Set FD = Application.FileDialog(msoFileDialogFilePicker)
        With FD
            .InitialFileName = ThisWorkbook.Path
            .AllowMultiSelect = False
            .Filters.Clear
            .Filters.Add "PDF", "*.pdf", 1
            .ButtonName = "Ouvrir fichier"
            .Title = "Sélectionner un fichier PDF"
        End With
    
        If FD.Show = True Then Lire2 FD.SelectedItems(1)
    
        Set FD = Nothing
    End Sub
    
    '   Cocher Reference : Microsoft Forms 2.0 Object Library
    Sub Lire2(sFichier As String)
    Dim PDDoc As Object
    Dim PDPage As Object
    Dim PDText As Object
    Dim TextSelt As Object
    Dim Rep As Long
    Dim i As Long, j As Long
    Dim wkPage As Long
    Dim wkCnt As Long
    Dim wkText As String
    Dim FName As String
    Dim oDO As Object
    
        FName = sFichier
        Set PDDoc = CreateObject("AcroExch.PDDoc")
        Rep = PDDoc.Open(FName)
    
        Set TextSelt = CreateObject("AcroExCh.HiliteList")
        TextSelt.Add 0, 32767
    
        wkPage = PDDoc.GetNumPages()
        For i = 0 To wkPage - 1
            Set PDPage = PDDoc.AcquirePage(i)
            Set PDText = PDPage.CreatePageHilite(TextSelt)
            wkCnt = PDText.GetNumText()
            For j = 0 To wkCnt - 1
                wkText = wkText & PDText.GetText(j)
            Next j
        Next i
        PDDoc.Close
    
        Set PDPage = Nothing
        Set PDText = Nothing
    
        Set oDO = New MSForms.DataObject
        oDO.Clear
        oDO.SetText wkText
        oDO.PutInClipboard
    
        Application.ScreenUpdating = False
        ShTest.Cells.Clear
        ShTest.Range("A1").PasteSpecial
    
        Set oDO = Nothing
        Set TextSelt = Nothing
        Set PDDoc = Nothing
    
        ShTest.Range("H1").Select
        Application.ScreenUpdating = True
    End Sub
    On peut également remplacer
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    wkText = wkText & PDText.GetText(j)
    par
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    wkText = wkText & vbTab & PDText.GetText(j)
      9  0

  4. #4
    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 276
    Points
    11 276
    Par défaut
    Rechercher un mot dans un fichier PDF via Acrobat

    Ajouter un bouton et l'affecter à la procédure SelFichier

    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
    Option Explicit
     
    Sub SelFichier_Acrobat()
    Dim Fichier As Variant
    Dim sMot As String
     
        ChDir ThisWorkbook.Path
     
        ' Mot à rechercher
        sMot = "Système de refroidissement"
     
        Fichier = Application.GetOpenFilename("Fichier PDF (*.pdf), *.pdf")
        If Fichier <> False Then AcrobatFindText Fichier, sMot
    End Sub
     
    Private Sub AcrobatFindText(ByVal sFichier As String, ByVal sRch As String)
    Dim AcroApp As Object
    Dim AvDoc As Object
    Dim iTrouvé As Integer
     
        Set AcroApp = CreateObject("AcroExch.App")
        AcroApp.Hide
     
        Set AvDoc = CreateObject("AcroExch.AVDoc")
        Application.StatusBar = ""
     
        If AvDoc.Open(sFichier, "") Then
            If Len(sRch) > 0 Then
                '   Parametres FindText
                '       StringToSearchFor ,
                '       caseSensitive (1 Or 0),
                '       WholeWords(1 Or 0),
                '       ResetSearchToBeginOfDocument (1 Or 0)
     
                '   Renvoie -1 si Trouvé, 0 autrement
     
                iTrouvé = AvDoc.FindText(sRch, True, True, True)
                If iTrouvé = True Then
                    Application.StatusBar = sRch & " : Trouvé"
                    AcroApp.Show
                    AvDoc.BringToFront
                Else
                    AvDoc.Close (1)
                    Application.StatusBar = sRch & " : Introuvable"
                End If
            End If
        End If
     
        Set AvDoc = Nothing
        Set AcroApp = Nothing
    End Sub
    Rechercher un mot dans un fichier PDF via Internet Explorer
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    Option Explicit
     
     
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
     
     
    Sub SelFichier()
    Dim FD As FileDialog, sStr As String
     
     
    Set FD = Application.FileDialog(msoFileDialogFilePicker)
    With FD
    .InitialFileName = ThisWorkbook.Path
    .AllowMultiSelect = False
    .Filters.Clear
    .Filters.Add "PDF", "*.pdf", 1
    .ButtonName = "Ouvrir fichier"
    .Title = "Sélectionner un fichier PDF"
    End With
     
     
    If FD.Show = True Then
    DoEvents
    ' Mot à rechercher
    sStr = "Investments"
    RchMot_PDF_IExplorer FD.SelectedItems(1), sStr
    End If
     
     
     
    Set FD = Nothing
    End Sub
     
    Private Sub RchMot_PDF_IExplorer(sFichier As String, sMot As String)
    Dim IE As Object
     
    Set IE = CreateObject("InternetExplorer.Application")
     
    IE.Navigate sFichier
    IE.Visible = True
     
    ' Attente de la fin du chargement
    Do Until IE.ReadyState = 4
    DoEvents
    Loop
     
    SendKeys "^f", True
    Sleep 250
    SendKeys sMot, True
    Sleep 100
    SendKeys "{ENTER}"
     
    Set IE = Nothing
    End Sub
      9  0

  5. #5
    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 276
    Points
    11 276
    Par défaut
    Fusion de fichiers 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
    Option Explicit
     
    Sub Fusion_PDFs()
    Dim oPDDoc1 As Object
    Dim oPDDoc2 As Object
    Dim oPDDoc3 As Object
    Dim Num As Long
     
        Set oPDDoc1 = CreateObject("AcroExch.PDDoc")
        Set oPDDoc2 = CreateObject("AcroExch.PDDoc")
        Set oPDDoc3 = CreateObject("AcroExch.PDDoc")
     
        oPDDoc1.Open (ThisWorkbook.Path & "\" & "1.pdf")
        oPDDoc2.Open (ThisWorkbook.Path & "\" & "2.pdf")
        oPDDoc3.Open (ThisWorkbook.Path & "\" & "3.pdf")
     
        '   Pour connaitre le nombre de pages
        '       Num = oPDDoc1.GetNumPages()
     
        '  Paramètres :
        '   1 Page du document en cours après laquelle l'insertion sera faite. La 1ere page est 0.
        '   2 Document contenant les pages à insérer.
        '   3 La 1ere page à être insérée dans le document en cours à partir du Document contenant les pages à insérer.
        '   4 Le nombre de pages à insérer.
        '   5 Si nombre > 0 les bookmarks sont copiés, si 0 ils ne le sont pas.
     
        oPDDoc1.InsertPages 0, oPDDoc2, 0, 1, 0
        oPDDoc1.InsertPages 1, oPDDoc3, 0, 1, 0
     
        oPDDoc1.Save 1, ThisWorkbook.Path & "\" & "Fusion.pdf"
     
        oPDDoc3.Close
        oPDDoc2.Close
        oPDDoc1.Close
     
        Set oPDDoc3 = Nothing
        Set oPDDoc2 = Nothing
        Set oPDDoc1 = Nothing
    End Sub
      12  0

  6. #6
    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 276
    Points
    11 276
    Par défaut
    Impression Document Word en PDF

    Testé sous Excel XP ( 2002 SP3 ) / Acrobat 6.0.6 Pro / Distiller 6.0.1
    Early Binding
    sous VBE Menu Outils | Références cocher Acrobat Distiller

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    Option Explicit
     
    Sub Tst_WORD_Adobe_PDF()
    Dim sNomFichierPS As String
    Dim sNomFichierPDF As String
    Dim sNomFichierLOG As String
    Dim PDFDist As PdfDistiller
    Dim sPrinterDefault As String
     
        sPrinterDefault = Application.ActivePrinter
        Application.ActivePrinter = "Adobe PDF"
     
        sNomFichierPS = ThisDocument.Path & "\" & "Essai_Word_AdobePDF.ps"
        sNomFichierPDF = ThisDocument.Path & "\" & "Essai_Word_AdobePDF.pdf"
        sNomFichierLOG = ThisDocument.Path & "\" & "Essai_Word_AdobePDF.log"
     
        ThisDocument.PrintOut outputFilename:=sNomFichierPS, PrintToFile:=True, Background:=False, Range:=wdPrintAllDocument
     
        Set PDFDist = New PdfDistiller
        PDFDist.FileToPDF sNomFichierPS, sNomFichierPDF, ""
        Set PDFDist = Nothing
     
        Kill sNomFichierPS
        Kill sNomFichierLOG
     
        Application.ActivePrinter = sPrinterDefault
    End Sub
    Pour n'imprimer qu'une page donnée d'un document
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
        ' Aller à la page 2 et l'imprimer
        Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="2"
        ThisDocument.PrintOut outputFilename:=sNomFichierPS, PrintToFile:=True, Background:=False, Range:=wdPrintCurrentPage
    Pour imprimer de la Page x à la Page y
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
        ' Imprimer de la Page 3 à la Page 4
        ThisDocument.PrintOut outputFilename:=sNomFichierPS, PrintToFile:=True, Background:=False, Range:=wdPrintFromTo, From:="3", To:="4"
    Pour imprimer des Pages non contiguës
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    Dim sPages As String
     
        ' Imprimer les Pages 2 à 3 et la Page 5
        sPages = "2-3,5"
        ThisDocument.PrintOut outputFilename:=sNomFichierPS, PrintToFile:=True, Background:=False, Range:=wdPrintRangeOfPages, Pages:=sPages
      9  0

  7. #7
    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 276
    Points
    11 276
    Par défaut
    PDFCreator Envoi par Mail d'un fichier PDF protégé

    Testé avec PDFCreator 1.2.3, Windows XP SP3, OExpress, Excel 2007

    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 Mail()
    Dim Destinataire As String
    Dim objMessage As Object
    Dim sNomPdf As String
    Dim sDossier As String
    Dim sNomCrypt As String
     
        sDossier = ThisWorkbook.Path
     
        Destinataire = "zzzzz@wwwww.fr"
        sNomPdf = sDossier & "\" & "Essai.pdf"
     
        Feuil1.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=sNomPdf, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
     
        sNomCrypt = sDossier & "\" & "Tempo.pdf"
        EncryptPDFUsingPdfforgeDll sNomPdf, sNomCrypt
     
        Kill sNomPdf
        Name sNomCrypt As sNomPdf
     
        Set objMessage = CreateObject("CDO.Message")
     
        With objMessage
            .Subject = "Essai"
            .From = "xxxxx@yyyyy.fr"
            .To = Destinataire
            .TextBody = "Bonjour, ceci est un test"
            .AddAttachment sNomPdf
            .Send
        End With
     
        Set objMessage = Nothing
    End Sub
     
    Private Sub EncryptPDFUsingPdfforgeDll(sNomFichier As String, sOutputCrypt As String)
    Dim Pdf As Object, Crypt As Object
     
        Set Crypt = CreateObject("pdfforge.pdf.PDFEncryptor")
     
        With Crypt
            .AllowAssembly = False
            .AllowCopy = False
            .AllowFillIn = False
            .AllowModifyAnnotations = False
            .AllowModifyContents = False
            .AllowPrinting = True
            .AllowPrintingHighResolution = True
            .AllowScreenReaders = False
            .EncryptionMethod = 2
     
            .OwnerPassword = "master"
            .UserPassword = ""
        End With
     
        Set Pdf = CreateObject("pdfforge.pdf.pdf")
        Pdf.EncryptPDFFile sNomFichier, sOutputCrypt, Crypt
        Set Pdf = Nothing
     
        Set Crypt = Nothing
    End Sub
      7  0

  8. #8
    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 276
    Points
    11 276
    Par défaut
    PDFCreator Fusion de fichiers 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
     
    Option Explicit
     
    Sub Fusion()
    Dim Pdf As Object, Fichiers(2)
        Set Pdf = CreateObject("pdfforge.pdf.pdf")
     
        Fichiers(0) = ThisWorkbook.Path & "\" & "1.pdf"
        Fichiers(1) = ThisWorkbook.Path & "\" & "2.pdf"
        Fichiers(2) = ThisWorkbook.Path & "\" & "3.pdf"
     
        Pdf.MergePDFFiles_2 Fichiers, ThisWorkbook.Path & "\" & "Fusion.pdf", True
     
        Set Pdf = Nothing
    End Sub
    Fusion des PDF d'un Dossier
    Affecter un bouton à SelDossierFusion
    Procédure récursive ou non
    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
    Option Explicit
     
    Dim Cpt As Long
    Dim Tableau() As Variant
    Const TypeFichier As String = "*.pdf"
     
    Private Sub Fusion()
    Dim Pdf As Object
        Set Pdf = CreateObject("pdfforge.pdf.pdf")
        Pdf.MergePDFFiles_2 Tableau, ThisWorkbook.Path & "\" & "Fusion Dossier.pdf", True
        Set Pdf = Nothing
    End Sub
     
    Private Sub ListeFichiers(ByVal sChemin As String, ByVal Recursif As Boolean)
    Dim FSO As Object
    Dim Dossier As Object
    Dim SousDossier As Object
    Dim Fichier As Object
     
        Set FSO = CreateObject("Scripting.FileSystemObject")
        Set Dossier = FSO.GetFolder(sChemin)
     
        For Each Fichier In Dossier.Files
            If UCase(Fichier.Name) Like UCase(TypeFichier) Then
                ReDim Preserve Tableau(Cpt)
                Tableau(Cpt) = Fichier.Path
                Cpt = Cpt + 1
                Application.StatusBar = Cpt
            End If
        Next Fichier
     
        If Recursif Then
            For Each SousDossier In Dossier.SubFolders
                ListeFichiers SousDossier.Path, True
            Next SousDossier
        End If
     
        Set Dossier = Nothing
        Set FSO = Nothing
    End Sub
     
    Sub SelDossierFusion()
    Dim sChemin As String
     
        sChemin = ThisWorkbook.Path
        With Application.FileDialog(msoFileDialogFolderPicker)
            .InitialFileName = sChemin & "\"
            .Title = "Sélectionner un Dossier"
            .AllowMultiSelect = False
            .InitialView = msoFileDialogViewDetails
            .ButtonName = "Sélection Dossier"
            .Show
            If .SelectedItems.Count > 0 Then
                Application.StatusBar = ""
                DoEvents
                Cpt = 0
                Erase Tableau
               '    ListeFichiers récursive ou non True/False
                ListeFichiers .SelectedItems(1), True
                Fusion
            End If
        End With
    End Sub
      9  0

  9. #9
    Invité
    Invité(e)
    Par défaut
    Salut Kiki

    Merci pour tous ces petits bouts de code très utiles, j'en ai utilisé un la semaine dernière

    Et j'étais avec Acrobat 10

    Philippe
      1  0

  10. #10
    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 : 67
    Localisation : France, Ardennes (Champagne Ardenne)

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

    Informations forums :
    Inscription : décembre 2006
    Messages : 5 138
    Points : 9 548
    Points
    9 548
    Par défaut
    Bonjour le forum, Kiki,
    Je n'ai pas le temps ni l'opportunité de teste tes propositions mais chapeau ! pour ton travail,
    J'ai ajouté ta contribution à mes favoris et ne manquerai pas d'y revenir.

    Encore bravo,
    Bonne journée à toi et tout le forum.

    Cordialement,
    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...)
      1  0

  11. #11
    Membre du Club
    Profil pro
    Inscrit en
    février 2011
    Messages
    49
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : février 2011
    Messages : 49
    Points : 50
    Points
    50
    Par défaut
    Super boulot !
    Ca m'amène une question PDF===> Excel, possible?
      1  0

  12. #12
    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 276
    Points
    11 276
    Par défaut
    PDFCreator Découpage d'un fichier PDF en fichiers unitaires
    Affecter un bouton à SelFichier
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    Option Explicit
     
    Private Sub DecoupagePDF(sNomFichier As String)
    Dim pdf As Object
    Dim sNom As String, Pos As Long
        Pos = InStrRev(sNomFichier, "\")
        sNom = Right$(sNomFichier, Len(sNomFichier) - Pos)
        Pos = InStr(sNom, ".")
        sNom = Left$(sNom, Pos - 1)
     
        Set pdf = CreateObject("pdfforge.pdf.pdf")
        pdf.SplitPDFFile sNomFichier, sNom & ".pdf"
        Set pdf = Nothing
    End Sub
     
    Sub SelFichier()
        With Application.FileDialog(msoFileDialogFilePicker)
            .InitialFileName = ThisWorkbook.Path & "\"
            .Title = "Sélectionner un Fichier"
            .AllowMultiSelect = False
            .InitialView = msoFileDialogViewDetails
            .ButtonName = "Sélection Fichier"
            .Show
            If .SelectedItems.Count > 0 Then
                DoEvents
                DecoupagePDF .SelectedItems(1)
            End If
        End With
    End Sub
      6  0

  13. #13
    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 276
    Points
    11 276
    Par défaut
    PDFCreator Conversion d'images Tif Bmp Png Jpg Gif d'un dossier dans un seul PDF résultant

    Affecter un bouton à SelDossierImages
    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
    Option Explicit
     
    Dim Cpt As Long
    Dim Tableau() As Variant
    Dim TypeFichier(4) As String
     
    Private Sub Fusion()
    Dim tools As Object, pdf As Object
        Set tools = CreateObject("pdfforge.tools")
        Set pdf = CreateObject("pdfforge.pdf.pdf")
     
        '0 La page Pdf s'adaptera à la taille de l'image
        '1 L'image s'adaptera au format A4
        pdf.Images2PDF_2 Tableau, "Images.pdf", 1
     
        Set pdf = Nothing
        Set tools = Nothing
    End Sub
     
    Private Sub ListeFichiers(ByVal sChemin As String, ByVal bRecursif As Boolean)
    Dim FSO As Object
    Dim Dossier As Object
    Dim SousDossier As Object
    Dim Fichier As Object
    Dim i As Long
     
        Set FSO = CreateObject("Scripting.FileSystemObject")
        Set Dossier = FSO.GetFolder(sChemin)
     
        For Each Fichier In Dossier.Files
            For i = LBound(TypeFichier) To UBound(TypeFichier)
                If UCase(Fichier.Name) Like UCase(TypeFichier(i)) Then
                    ReDim Preserve Tableau(Cpt)
                    Tableau(Cpt) = Fichier.Path
                    Cpt = Cpt + 1
                    Application.StatusBar = Cpt
                End If
            Next i
        Next Fichier
     
        If bRecursif Then
            For Each SousDossier In Dossier.SubFolders
                ListeFichiers SousDossier.Path, True
            Next SousDossier
        End If
     
        Set Dossier = Nothing
        Set FSO = Nothing
    End Sub
     
    Sub SelDossierImages()
    Dim sChemin As String
     
        sChemin = ThisWorkbook.Path
        With Application.FileDialog(msoFileDialogFolderPicker)
            .InitialFileName = sChemin & "\"
            .Title = "Sélectionner un Dossier"
            .AllowMultiSelect = False
            .InitialView = msoFileDialogViewDetails
            .ButtonName = "Sélection Dossier"
            .Show
            If .SelectedItems.Count > 0 Then
                TypeFichier(0) = "*.tif"
                TypeFichier(1) = "*.bmp"
                TypeFichier(2) = "*.png"
                TypeFichier(3) = "*.jpg"
                TypeFichier(4) = "*.gif"
                DoEvents
                Cpt = 0
                Erase Tableau
                ' Recherche récursive ou non True/False
                ListeFichiers .SelectedItems(1), True
                Fusion
            End If
        End With
    End Sub
      6  0

  14. #14
    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 276
    Points
    11 276
    Par défaut
    PDFCreator Insertion Image de fond dans Document Pdf
    Cette image se centre automatiquement et de sa définition dépendra la surface couverte sur le document
    On n'a accès ni à son positionnement xy ni à un facteur d'échelle

    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
    Option Explicit
     
    Sub Tst_Filigrane()
    Dim pdf As Object, SNomFichier As String
     
         'Public Function StampPDFFileWithImage( _
         '    sourceFilename As String, _
         '    destinationFilename As String, _
         '    imageFilename As String, _
         '    fromPage As Integer, _
         '    toPage As Integer, _
         '    overUnder As Boolean, _
         '    fillOpacity As Single, _
         '    blendMode As Integer _
         ') As Integer
     
        '	Blend mode
        '1 	Color burn
        '2 	Color dodge
        '3 	Color compatible
        '4 	Color darken
        '5 	Color difference
        '6 	Color exclusion
        '7 	Color hardlight
        '8 	Color lighten
        '9 	Color multiply
        '10 Color normal
        '11 Color overlay
        '12 Color screen
        '13 Color softlight
     
        SNomFichier = ThisWorkbook.Path & "\" & "Snoopy.jpg"
        Set pdf = CreateObject("pdfforge.pdf.pdf")
     
        ' L'image sera en arrière plan : overUnder = False
        pdf.StampPDFFileWithImage "Document.pdf", "Document Snoopy.pdf", SNomFichier, 1, 1, False, 0.5, 10
     
        Set pdf = Nothing
    End Sub
      6  0

  15. #15
    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 276
    Points
    11 276
    Par défaut
    PDFCreator Ajout de Texte, Ligne et Hirondelles sur un Document Pdf

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    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
    Option Explicit
     
    Sub Tst_AjoutTexteLigneHirondelles()
    Dim pdf As Object, pdfText As Object, pdfLine As Object, pdfLine2 As Object
    Dim sNomDoc As String
     
        Set pdf = CreateObject("pdfforge.pdf.pdf")
        Set pdfText = CreateObject("pdfforge.pdf.pdfText")
        Set pdfLine = CreateObject("pdfforge.pdf.pdfline")
        Set pdfLine2 = CreateObject("pdfforge.pdf.pdfline")
     
        sNomDoc = ThisWorkbook.Path & "\" & "Document.pdf"
     
        With pdfText
            .fillOpacity = 1
     
            .FontColorBlue = 62
            .FontColorGreen = 125
            .FontColorRed = 255
     
            .FontName = "comic.TTF"
            .FontSize = 55
            .Rotation = 45
            .Text = "Essai Essai Essai Essai Essai"
            .XPosition = 25
            .YPosition = 100
     
            'Public Function AddTextToPDFFile( _
             '    sourceFilename As String, _
             '    destinationFilename As String, _
             '    fromPage As Integer, _
             '    toPage As Integer, _
             '    ByRef textObject As pdfText _
             ') As Integer
     
            pdf.AddTextToPDFFile sNomDoc, "AddText.pdf", 1, 1, pdfText
        End With
     
        With pdfLine
            .FromX = 25
            .FromY = 95
            .ToX = .FromX + 180
            .ToY = .FromY + 180
     
            .LineColorRed = 60
            .LineColorGreen = 125
            .LineColorBlue = 255
     
            .LineThickness = 4
            .UnitsOn = 5
            .UnitsOff = 2.5
            .Phase = 5
     
            'Public Function AddLineToPDFFile( _
             '    sourceFilename As String, _
             '    destinationFilename As String, _
             '    fromPage As Integer, _
             '    toPage As Integer, _
             '    ByRef lineObject As pdfLine _
             ') As Integer
     
            pdf.AddLineToPDFFile "AddText.pdf", "AddTextLine.pdf", 1, 1, pdfLine
        End With
     
        With pdfLine2
            .UnitsOn = 5
            .UnitsOff = 0
     
            'Public Function AddCropMarksToPDFFile( _
             '    sourceFilename As String, _
             '    destinationFilename As String, _
             '    fromPage As Integer, _
             '    toPage As Integer, _
             '    borderTopMillimeter As Single, _
             '    borderBottomMillimeter As Single, _
             '    borderLeftMillimeter As Single, _
             '    borderRightMillimeter As Single, _
             '    ByRef lineObject As pdfLine _
             ') As Integer
     
            pdf.AddCropMarksToPDFFile "AddTextLine.pdf", "AddTextLineCrop.pdf", 1, 0, 5, 5, 5, 5, pdfLine2
        End With
     
        Set pdfLine2 = Nothing
        Set pdfLine = Nothing
        Set pdfText = Nothing
        Set pdf = Nothing
    End Sub
      7  0

  16. #16
    Responsable
    Office & Excel


    Homme Profil pro
    Formateur et développeur chez EXCELLEZ.net
    Inscrit en
    novembre 2003
    Messages
    18 003
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur et développeur chez EXCELLEZ.net
    Secteur : Enseignement

    Informations forums :
    Inscription : novembre 2003
    Messages : 18 003
    Points : 51 780
    Points
    51 780
    Billets dans le blog
    97
    Par défaut
    Salut Philippe,

    Très chouette boulot. Si tu souhaites développer dans un tuto plus étoffé, tu sais que tu peux me contacter...

    Cela étant, je cherche une solution (gratuite ou payante, mais si payante, je dois pouvoir distribuer mon code, éventuellement au sein d'un DLL COM que j'écrirais alors en VB6 sans obliger les utilisateurs à acquérir une version payante) pour pouvoir :
    1. fusionner des pdf en choisissant les pages à fusionner;
    2. splitter des pdf ;
    3. ajouter un cartouche à un endroit déterminé d'une page ;
    4. ajouter un entête ou un pied de page;
    5. visionner un pdf dans un contrôle viewer;
    6. ...



    J'ai vu que tes codes permettaient presque tout ce que je demande, sauf peut-être le placement d'un cartouche (texte ou image) en pied ou "n'importe où" (=> à un endroit précis d'une page du document).

    Mais tu utilises plusieurs technos (Acrobat et PDF Creator) or je souhaite, pour la facilité de mon client, n'utiliser qu'un seul logiciel, et je ne sais pas si Acrobat peut être redistribuable et si tu utilises la version Pro de PDF Creator et si cette version est différente de la version gratuite...

    Au passage, c'est quoi une hirondelle?

    Cordialement,
    "Plus les hommes seront éclairés, plus ils seront libres" (Voltaire)
    ---------------
    Mes remarques et critiques sont purement techniques. Ne les prenez jamais pour des attaques personnelles...
    Pensez à utiliser les tableaux structurés. Ils vous simplifieront la vie, tant en Excel qu'en VBA ==> mon tuto
    Le VBA ne palliera jamais une mauvaise conception de classeur ou un manque de connaissances des outils natifs d'Excel...
    Ce ne sont pas des bonnes pratiques parce que ce sont les miennes, ce sont les miennes parce que ce sont des bonnes pratiques
    VBA pour Excel? Pensez D'ABORD en EXCEL avant de penser en VBA...
    ---------------
      1  0

  17. #17
    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 276
    Points
    11 276
    Par défaut
    PDFCreator Création d'une brochure
    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
    Option Explicit
     
    Sub Tst_Brochure()
    Dim pdf As Object
     
        ' Nécessite idéalement une Imprimante Recto/Verso
     
        Set pdf = CreateObject("pdfforge.pdf.pdf")
     
        'Public Function CreatePDFTestDocument( _
         '    destinationFilename As String, _
         '    countOfPages As Integer, _
         '    additionalText As String, _
         '    addPagenumbers As Boolean _
         ') As Integer
     
        pdf.CreatePDFTestDocument "input.pdf", 8, "Essai", True
        pdf.Brochure "input.pdf", "Brochure.pdf"
     
        Kill "input.pdf"
        Set pdf = Nothing
    End Sub
      6  0

  18. #18
    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 276
    Points
    11 276
    Par défaut
    PDFCreator Disposer un nombre de pages donné sur une page
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    Option Explicit
     
    Sub Tst_Disposition()
    Dim pdf As Object, pdfLine As Object
     
        Set pdf = CreateObject("pdfforge.pdf.pdf")
        Set pdfLine = CreateObject("pdfforge.pdf.pdfline")
     
        pdf.CreatePDFTestDocument "input.pdf", 10, "Essai", True
     
        With pdfLine
            .UnitsOn = 5
            .UnitsOff = 0
            pdf.AddCropMarksToPDFFile "input.pdf", "Output.pdf", 1, 0, 5, 5, 5, 5, pdfLine
        End With
     
        'Public Function NUp( _
        '    sourceFilename As String, _
        '    destinationFilename As String, _
        '    pagesPerPage As Integer _
        ') As Integer
     
        pdf.NUp "Output.pdf", "Disposition.pdf", 4
     
        Kill "input.pdf"
        Kill "Output.pdf"
        Set pdfLine = Nothing
        Set pdf = Nothing
    End Sub
      5  0

  19. #19
    Responsable
    Office & Excel


    Homme Profil pro
    Formateur et développeur chez EXCELLEZ.net
    Inscrit en
    novembre 2003
    Messages
    18 003
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : Belgique

    Informations professionnelles :
    Activité : Formateur et développeur chez EXCELLEZ.net
    Secteur : Enseignement

    Informations forums :
    Inscription : novembre 2003
    Messages : 18 003
    Points : 51 780
    Points
    51 780
    Billets dans le blog
    97
    Par défaut
    Salut Philippe,

    Merci pour ces nouveaux exemples. Grâce à eux, j'entrevois la possibilité de réaliser ce que mon client souhaite.

    Pour le viewer, il suffit d'avoir acrobat reader et on peut disposer d'un contrôle ocx de visualisation sur un userform en VBA.

    C'est presque bingo sur toute la ligne.

    Bonne journée
    "Plus les hommes seront éclairés, plus ils seront libres" (Voltaire)
    ---------------
    Mes remarques et critiques sont purement techniques. Ne les prenez jamais pour des attaques personnelles...
    Pensez à utiliser les tableaux structurés. Ils vous simplifieront la vie, tant en Excel qu'en VBA ==> mon tuto
    Le VBA ne palliera jamais une mauvaise conception de classeur ou un manque de connaissances des outils natifs d'Excel...
    Ce ne sont pas des bonnes pratiques parce que ce sont les miennes, ce sont les miennes parce que ce sont des bonnes pratiques
    VBA pour Excel? Pensez D'ABORD en EXCEL avant de penser en VBA...
    ---------------
      2  0

  20. #20
    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 276
    Points
    11 276
    Par défaut
    PDFCreator Numérotation des Pages, En-Tête et Pied de page

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    Option Explicit
     
    Sub Tst_NumPages()
    Dim pdf As Object, pdfText As Object, WshShell As Object, pdfText2 As Object
     
        Set WshShell = CreateObject("WScript.Shell")
        Set pdf = CreateObject("pdfforge.pdf.pdf")
     
        pdf.CreatePDFTestDocument "input.pdf", 5, "Essai", False
     
        Set pdfText = CreateObject("pdfforge.pdf.pdfText")
        With pdfText
            .Text = "[PAGE] / [PAGES]"
            .FontColorRed = 200
            .FontName = "comicbd.TTF"
            .FontPath = WshShell.SpecialFolders("Fonts")
            .FontSize = 12
        End With
     
        Set pdfText2 = CreateObject("pdfforge.pdf.pdfText")
        With pdfText2
            .Text = "Coucou"
            .FontColorBlue = 200
            .FontName = "timesbd.ttf"
            .FontPath = WshShell.SpecialFolders("Fonts")
            .FontSize = 16
        End With
     
        'Public Function AddPageNumberToPDFFile( _
         '    sourceFilename As String, _
         '    destinationFilename As String, _
         '    fromPage As Integer, _
         '    toPage As Integer, _
         '    startPageNumber As Integer, _
         '    NumberOfPages As Integer, _
         '    pageNumberPosition As Integer, _
         '    borderXMillimeter As Single, _
         '    borderYMillimeter As Single, _
         '    ByRef textObject As pdfText _
         ') As Integer
     
        'Page number position
        '1: Top Left
        '2: Top middle
        '3: Top Right
        '4: bottom Left
        '5: bottom middle
        '6: bottom Right
     
        pdf.AddPageNumberToPDFFile "input.pdf", "NumPages.pdf", 1, 5, 1, 5, 6, 15, 15, pdfText
        pdf.AddPageNumberToPDFFile "NumPages.pdf", "NumPages2.pdf", 1, 5, 1, 5, 2, 15, 15, pdfText2
     
        Kill "input.pdf"
        Kill "NumPages.pdf"
     
        Set pdfText2 = Nothing
        Set pdfText = Nothing
        Set pdf = Nothing
        Set WshShell = Nothing
    End Sub
    Insertion x Pages d'un pdf dans un autre Pdf

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    Option Explicit
     
    Sub InsertionPages()
    Dim pdf As Object, pdfText As Object, WshShell As Object
    Dim iNbPages As Long
     
        Set pdf = CreateObject("pdfforge.pdf.pdf")
        pdf.CreatePDFTestDocument "test1.pdf", 4, "Doc1 de 4 Pages", True
        pdf.CreatePDFTestDocument "test2.pdf", 12, "Doc2 de 12 Pages", True
     
        'Public Function ReplacePagesFromPDFFile( _
         '    sourceFilename1 As String, _
         '    sourceFilename2 As String, _
         '    destinationFilename As String, _
         '    source1FromPage As Integer, _
         '    source1ToPage As Integer, _
         '    source2FromPage As Integer, _
         '    source2ToPage As Integer _
         ') As Integer
     
        '  Remplacer sur Test1 les pages 2 à 3 par les pages 4 à 8 de Test2
        pdf.ReplacePagesFromPDFFile "test1.pdf", "test2.pdf", "output.pdf", 2, 3, 4, 8
     
        ' Suppression pages vides
        pdf.RemoveEmptyPagesFromPDFFile "output.pdf", "output2.pdf"
        iNbPages = pdf.NumberOfPages("output2.pdf")
     
        Set WshShell = CreateObject("WScript.Shell")
        Set pdfText = CreateObject("pdfforge.pdf.pdfText")
        With pdfText
            .Text = "[PAGE] / [PAGES]"
            .FontColorRed = 200
            .FontName = "comicbd.TTF"
            .FontPath = WshShell.SpecialFolders("Fonts")
            .FontSize = 12
        End With
     
        'Public Function AddPageNumberToPDFFile( _
         '    sourceFilename As String, _
         '    destinationFilename As String, _
         '    fromPage As Integer, _
         '    toPage As Integer, _
         '    startPageNumber As Integer, _
         '    NumberOfPages As Integer, _
         '    pageNumberPosition As Integer, _
         '    borderXMillimeter As Single, _
         '    borderYMillimeter As Single, _
         '    ByRef textObject As pdfText _
         ') As Integer
     
        pdf.AddPageNumberToPDFFile "output2.pdf", "InsertionPages.pdf", 1, iNbPages, 1, iNbPages, 6, 15, 15, pdfText
     
        Kill "output.pdf"
        Kill "output2.pdf"
        Kill "test2.pdf"
        Kill "test1.pdf"
     
        Set WshShell = Nothing
        Set pdfText = Nothing
        Set pdf = Nothing
    End Sub
      8  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, 16h45
  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, 14h49
  3. Problème avec adobe acrobat reader
    Par Rabie de OLEP dans le forum Windows XP
    Réponses: 4
    Dernier message: 24/03/2007, 20h50
  4. Problème avec Adobe acrobat reader
    Par castelm dans le forum Autres Logiciels
    Réponses: 4
    Dernier message: 08/03/2007, 21h19
  5. Impression .PDF avec adobe
    Par popo68 dans le forum Access
    Réponses: 2
    Dernier message: 26/02/2007, 12h19

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