XL 2013 Fusionner des pdf en vba

controlo

XLDnaute Occasionnel
Bonjour les amis ,

Je cherche une façon en vba pour fusionner des pdf en un seul .J'au trouvé un bout de macro de KIKI29 que j'ai collé dans un module mais quand je l’exécute sa me donne le message suivant : un composant active x ne peut pas créer d'objet à la ligne Set oPDDoc1 = CreateObject("AcroExch.PDDoc") .N'étant pas un expert ,je compte sur votre aide . Merci
Pour info j'ai installé pdf creator 1.7.3 et j'ai coché dans les références pdf creator dans excel
 
Dernière édition:

GALOUGALOU

XLDnaute Accro
Bojour controlo bonjour le forum
En supposant que tous les PDF soit issu du même classeur Excel peut-être un début de solution sur le lien ci-dessus
cordialement
Galougalou
 

controlo

XLDnaute Occasionnel
Je pense pas avoir été assez explicite sur mes intentions en macro.
Je vais avoir un classeur excel qui va générer un pdf , ce même pdf devra être fusionné à un autre pdf ( issu de scan ou de pdf creator) , cette fusion devra être faite par macro (cette macro sera résidente du premier classeur excel . Mais je pense que si vous m'aidez à trouver la réponse à mon problème du 1er post après je pourrais arriver à ma solution.

PS : le deuxieme pdf à fusionné ,je ne peux l'avoir quand PDF( c'est un document que je reçois )

Merci pour votre aide .
 

kiki29

XLDnaute Barbatruc
Salut, ce message signifie qu'il te faut Acrobat ( payant ) pas le Reader, PDFCreator n'a rien à voir là dedans. De plus, sauf erreur de ma part, je développe en Early Binding et distribue en Late Binding : donc pas de référence à cocher.

Concernant la fusion de PDFs, via Acrobat ou PDFCreator, à voir suivant les outils dont tu disposes.
Je précise qu'il s'agit d'Acrobat ( pas du Reader ) ou de PDFCreator 1.7.3 pas des versions 2.x, 3.x ou autres ...
Étant définitivement fâché avec le Belge et ses mignons de couchette de Developpez.com, j'ai supprimé l'ensemble des téléchargements ( 110 au bas mot ), d'où les liens internes de téléchargement caduques. Ces téléchargements sont toujours disponibles sur mon PC, si quelqu'un en fait la demande.
 
Dernière édition:

kiki29

XLDnaute Barbatruc
Salut, une version allégée, sans références à cocher, la recherche récursive reste possible : par défaut elle est à false, à toi de l'adapter à ton contexte pour les chemins des dossiers in/out, nom de fichier
VB:
Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
                                             (ByVal hwnd As Long, _
                                              ByVal pszPath As String, _
                                              ByVal lngsec As Long) As Long

Option Explicit

Dim Fichiers() As Variant
Dim Cpt As Long
Const sRch As String = "pdf"

Private Function CreationDossier(sDossier As String) As Long
Dim Rep As Long
    Rep = SHCreateDirectoryEx(0&, sDossier, 0&)
End Function

Private Sub Liste(ByVal sChemin As String, ByVal bSousDossier As Boolean)
Dim FSO As Object, Dossier As Object, Fichier As String

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Dossier = FSO.GetFolder(sChemin)

    Fichier = Dir$(sChemin & "\*.*")

    Do While Len(Fichier) > 0
        If UCase$(FSO.GetExtensionName(Fichier)) Like (UCase$(sRch)) Then
            ReDim Preserve Fichiers(Cpt)
            Fichiers(Cpt) = sChemin & "\" & Fichier
            Cpt = Cpt + 1
        End If
        Fichier = Dir$()
    Loop

    If bSousDossier Then
        For Each Dossier In Dossier.SubFolders
            Liste Dossier.Path, True
        Next Dossier
    End If

    Set FSO = Nothing
End Sub

Private Function RenommerFichier(sDossier As String, sNomfichier As String) As String
Dim sNouveauNom As String
Dim sPre As String, sExt As String
Dim i As Long
Dim FSO As Object

    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Dir(sDossier & "\" & sNomfichier, vbNormal) <> vbNullString Then
        sNouveauNom = sNomfichier
        sPre = FSO.GetBaseName(sNomfichier)
        sExt = FSO.GetExtensionName(sNomfichier)

        i = 0
        While Dir(sDossier & "\" & sNouveauNom, vbNormal) <> vbNullString
            i = i + 1
            sNouveauNom = sPre & Chr(40) & Format(i, "000") & Chr(41) & Chr(46) & sExt
        Wend
        sNomfichier = sNouveauNom
    End If
    Set FSO = Nothing

    RenommerFichier = sDossier & "\" & sNomfichier
End Function

Sub Tst_Fusion_PDF()
Dim pdf As Object
Dim sDossierIn As String, sDossierOut As String
Dim sNomDossierPdf As String, sNomDossierFusion As String, sNomFichierFusion As String, sNom As String

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

    sNomDossierPdf = "Test PDF"
    sNomDossierFusion = "Fusion PDF"
    sNomFichierFusion = "Fusion.Pdf"

    sDossierIn = ThisWorkbook.Path & "\" & sNomDossierPdf
    sDossierOut = ThisWorkbook.Path & "\" & sNomDossierFusion

    CreationDossier sDossierOut
    Cpt = 0
    Liste sDossierIn, False

    sNom = RenommerFichier(sDossierOut, sNomFichierFusion)
    If Cpt > 0 Then pdf.MergePDFFiles_2 Fichiers, sNom, True

    Erase Fichiers
    Set pdf = Nothing
End Sub
 

Pièces jointes

  • 4.png
    4.png
    33.8 KB · Affichages: 137
Dernière édition:

controlo

XLDnaute Occasionnel
Bonjour Staple 1600,

Désolé mais quand je dit bonjour je m'adresse à tout le monde , a toi aussi et merci pour ton post ( mais j'avais trouvé avant de le voir ) désolé si j'ai froissé ta susceptibilité loin de moi cette intention .

A bientôt sur le forum
 

Staple1600

XLDnaute Barbatruc
Re

Il s'agit pas d'être froissé ou de pas l'être
C'est juste que d'habitude, quand on donne un conseil, une solution, un lien (what ever), le demandeur réagit par :
"Merci pour l'info"
etc...

Or pas vu de réaction de ta part suite au message#11
=>ce qui peut laisser croire:
1) que tu l'as zappé
2) que tu l'ignores

Bref, en général, quand on essaie d'aider un demandeur, on apprécie un petit retour de sa part.
Ni plus, ni moins.
 

Discussions similaires