Résolu Macro excel et pdfcreator

[Redba]

Bonjour a vous.
J'ai lu vous échange et pense que vous pouvez m'aider. je vous expose mon Souci :
J'ai un fichier excel (Pour simplifier) avec 4 colonnes
Colonne A j'ai un numéro 1 à X
Colonne B -> sFichier : j'ai le Nom du PDf (Ou le lien direct sDossierOut & sFichier du type C:\xxxx\fichier.pdf)
Colonne C sDossierOut : le dossier de sortie
Colonne D sFichierFusion : j'ai le nom du fichier = Feuil1.Range("D1").Value.

je souhaites pouvoir selon le cas soit :
* filtrer Manuellement sur la Colonne A et fusionner les Fichiers de la colonne B (obtenu avec le filtre) et le nom de fichier est celui en D
* filtrer automatiquement sur la Colonne A (avec une liste de nombre en colonne E) et fusionner les Fichiers de la colonne B (obtenu avec le filtre) et le nom de fichier est celui en D.

Si vous pouvez m'aider? J'ai trouver un macro pour fusionner suivant une liste. mais elle ne prends pas en compte le filtre. ci dessous :

Option Explicit

Sub combiner_liste_pdf()
Dim sDossierPDF As String
Dim sDossierOut As String
Dim sFichierFusion As String


sDossierPDF = "D:\Users\Redba\Desktop\xxx\"
sDossierOut = "D:\Users\Redba\Desktop\xxxxx\"
sFichierFusion = Feuil1.Range("D1").Value


FusionPDFs sDossierPDF, sDossierOut, sFichierFusion
End Sub

Private Sub FusionPDFs(sPdfDir As String, _
sPdfOutDir As String, _
sFichierOut As String)
Dim bFirst As Boolean
Dim oPDDoc As Object
Dim oTempPDDoc As Object
Dim LastRow As Long
Dim i As Long
Dim sFichier As String

bFirst = True
LastRow = Feuil1.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow
sFichier = Feuil1.Range("B" & i)
If bFirst Then
bFirst = False
Set oPDDoc = CreateObject("AcroExch.PDDoc")
oPDDoc.Open sPdfDir & sFichier
Else
Set oTempPDDoc = CreateObject("AcroExch.PDDoc")
oTempPDDoc.Open sPdfDir & "\" & sFichier
oPDDoc.InsertPages oPDDoc.GetNumPages - 1, oTempPDDoc, 0, oTempPDDoc.GetNumPages, 1
oTempPDDoc.Close
End If
Next i

With oPDDoc
.Save 1, sPdfOutDir & "\" & sFichierOut
.Close
End With

Set oPDDoc = Nothing
Set oTempPDDoc = Nothing
End Sub

 

[magellan]

Bonjour.

Merci de créer votre propre sujet afin d'avoir un suivi cohérent.