Enregistrer un PDF/DOC/JPG à partir d'Excel

[lepigoennier]

Bonjour,

J'ai créé un fichier qui me fait des hypertextes et je réussis à tous les ouvrir (mode démo de 19 lignes). Mon problème est que je voudrais enregistrer les documents ouverts dans un dossier particulier et qu'ils se ferment au fur et à mesure. Est-ce que quelqu'un pourrait m'aider pour la solution. Je ne veux pas enregistrer manuellement 2000 fichiers. De plus mon ordi ne les ouvrira pas tous.

Merci

Sub Test()

Dim Cell As Range
Dim x As Integer
Dim HL As Hyperlink

x = Worksheets(1).Range("d65536").End(xlUp).Row

For Each Cell In Worksheets(1).Range("d2:d" & x)
Worksheets(1).Hyperlinks.Add Cell.Offset(0, 1), Cell
DeclencheLien Range("e2:e" & x)
Next Cell

For Each HL In Worksheets(1).Range("e2:e" & x).Hyperlinks
HL.Follow
Next


End Sub


Sub DeclencheLien(Cellule As Range)

'Déclenche le lien

Cellule.Hyperlinks(1).Follow NewWindow:=True

End Sub

 

[Jack2]

Re : Enregistrer un PDF/DOC/JPG à partir d'Excel

Bonsoir lepigoennier,

Tel que tu décris ton problème, il n'est pas nécessaire d'ouvrir les fichiers Pdf, et donc de les fermer. Dans ce cas, il faudrait que tu détermines un ou plusieurs dossiers contenant ces fichiers et un ou plusieurs dossiers où les copier (ou délacer, selon ce que tu veux faire). Toutes ces données peuvent apparaître dans ta feuille Excel.
Si c'est cela que tu souhaites, envoie un exemple.

A+ Jack2

 

[lepigoennier]

Re : Enregistrer un PDF/DOC/JPG à partir d'Excel

Voici les faits : j'ai environ 5000 certificats dans différents dossiers et je dois faire une copie de ceux pertinents pour mon client dans un dossier (pour moi) afin de les mettre sur un CD (pour le client). Je croyais que je devais ouvrir le fichier pour pouvoir enregistrer le document, mais si tu as une idée pour faire autrement et plus rapidement, je suis preneure. Tu vas trouver les informations dans le fichier joint.

MErci

 

[Jack2]

Re : Enregistrer un PDF/DOC/JPG à partir d'Excel

Bonsoir lepigoennier,

Ci-après une procédure pour copier des fichiers d'un répertoire vers un autre :

' cas où l'on copie tous les fichiers
Sub Copier_Tous_Les_Fichiers_D_un_Repertoire()
Dim FSO As Object
Dim DossierSource As Object
Dim Fichier As Object
Dim NomFich As String
Dim Rep_Init As String, Rep_Fin As String

'Choisir le répertoire source
Rep_Init = ChoisirRepertoire("Répertoire d'origine")
'Choisir le répertoire de destination
Rep_Fin = ChoisirRepertoire("Répertoire de destination")


Set FSO = CreateObject("Scripting.FileSystemObject")
Set DossierSource = FSO.GetFolder(Rep_Init)

'pour chaque fichier du répertoire source
For Each Fichier In DossierSource.Files
    NomFich = Fichier.Name
        'le copier dans le répertoire de destination
        FSO.CopyFile Rep_Init & NomFich, Rep_Fin & nomfihc, True
Next Fichier
    
 Set DossierSource = Nothing
 Set FSO = Nothing
End Sub

Comme je n'avais pas sommeil, je t'ai mis dans le fichier joint quelques procédures pour te servir de base. Dans "Copier_Fichiers_Avec_Filtre_Simple_Et_Liste" on liste les fichiers qui sont copiés. On peut dans un premier temps lister les fichiers d'un répertoire dans une feuille. Tu tries ceux qui te semblent pertinents, on les lit ensuite dans la feuille et on les copie.
Maintenant j'ai sommeil!!!

A+ Jack2

 

[lepigoennier]

Re : Enregistrer un PDF/DOC/JPG à partir d'Excel

Je te remercie pour tes exemples, mais ce n'est pas ce dont j'ai besoin.

Les certificats se trouvent présentement dans plusieurs dossiers (dans mon document : A,B,C,D,E,F).
A contient 150 fichiers
B contient 20 fichiers
C contient 75 fichiers
etc.

BAA 18 déc.xlsm: dans la colonne D, il y a l'adresse complète pour ouvrir le document et dans la colonne E, c'est le lien hypertxte (lien_hypertexte( ; )). Ce que je voudrais c'est copier seulement les 16 certificats qui se trouvent dans mon document dans un dossier x.

Si ce n'était que 16 certificats, ça irait, mais je dois en copier environ 1500 parmi le 5500 que j'ai (répartis dans 95 dossiers) et je dois faire la même chose pour plusieurs dossiers clients.

Merci si tu peux m'aider à solutionner mon problème

 

[Jack2]

Re : Enregistrer un PDF/DOC/JPG à partir d'Excel

Bonjour lepigoennier,

D'après le fichier que tu m'as donné, le code suivant devrait fonctionner (je vérifierait à la maison) :

Sub Copier_Fichiers_Colonne_D()
Dim FSO As Object
Dim NomFich As Strin
Dim St As String, Ext As String
Dim Rep_Init As String, Rep_Fin As String
Dim Derlig As Integer
Dim i As Long

Rep_Fin = "C:\Destination\" ' adapater

Sheets("Données").Select
Derlig = Range("D" & Rows.Count).End(xlUp).Row
For i = 2 To Derlig
    If Range("D" & i) <> "" Then
        St = CStr(Range("D" & i))
        Ext = Right(St, 4)
        Rep_Init = Replace(St, CStr(Range("E" & i)) & Ext, "")
        NomFich = Trim(Replace(St, Rep_Init, ""))
        Set FSO = CreateObject("Scripting.FileSystemObject")
        FSO.CopyFile Rep_Init & NomFich, Rep_Fin & NomFich, True
        Set FSO = Nothing
    End If
Next i
End Sub

Ne pas oublier de cocher dans Outils, Références : Microsoft Scripting Runtime

A+ Jack2

EDIT J'ai rajouté des points avant pdf dans la colonne D pour avoir une extension correcte

 

[lepigoennier]

Re : Enregistrer un PDF/DOC/JPG à partir d'Excel

Bonjour Jack2,

J'ai bien essayé ton code, mais ça bloque à cette ligne (il semble bien me donner le nom des répertoires de début et de fin, mais c'est le nom du fichier qui semble boguer) :
FSO.CopyFile Rep_Init & NomFich, Rep_Fin & NomFich, True

Si je met le nom du fichier dans une colonne, est-ce que ça serait plus simple? Je l'ai dans une base de donnée ainsi que l'adresse du dossier. J'ai du concatener pour avoir ma colonne D.

Merci

 

[Jack2]

Re : Enregistrer un PDF/DOC/JPG à partir d'Excel

Bonsoir lepigoennier,

Excuses, je suis allé trop vite, sans vérifier (FSO mal placé). Ci-après le code dans le bon ordre :

Sub Copier_Fichiers_Colonne_D()
Dim FSO As Object
Dim NomFich As String
Dim St As String
Dim Rep_Init As String, Rep_Fin As String
Dim Derlig As Integer
Dim i As Long

Set FSO = CreateObject("Scripting.FileSystemObject")
Rep_Fin = "D:\Destination\" ' adapater
Sheets("Données").Select
Derlig = Range("D" & Rows.Count).End(xlUp).Row

For i = 2 To Derlig
    If Range("D" & i) <> "" Then
        St = CStr(Range("D" & i))
        Rep_Init = Replace(St, CStr(Range("E" & i)) & Right(St, 4), "")
        NomFich = Trim(Replace(St, Rep_Init, ""))
        FSO.CopyFile Rep_Init & NomFich, Rep_Fin & NomFich, True
    End If
Next i
Set FSO = Nothing
End Sub

J'ai testé, ça fonctionne. Les fichiers listés dans la colonne D sont copiés vers le répertoire de destination à partir des répertoires d'origines.
Si ta base de données est compatible avec Excel VBA, il est peut-être possible d'automatiser la concaténation vers la colonne D (ou autre).

A+ Jack2

 

[lepigoennier]

Re : Enregistrer un PDF/DOC/JPG à partir d'Excel

Je te remercie Jack2, mais ça ne fonctionne toujours pas. Ça bloque toujours à la même ligne. Lorsque je passe mon curseur sur cette ligne, ça donne bien en dossier source et un dossier destination, mais NomFich est vide. Il semblerait que c'est là que ça bloque, mais je sèche sur la solution.

MErci

 

[Jack2]

Re : Enregistrer un PDF/DOC/JPG à partir d'Excel

Bonjour lepigoennier,

Je viens de vérifier au bureau, ça fonctionne parfaitement avec 3 dossiers sources et 1 dossier destination (4 types de fichiers différents). Si ça bloque toujours sur la même ligne, c'est que le nom de fichier transmis est mauvais. Je pense que cela vient du fait que tes fichiers en colonne D n'ont pas d'extension. Pour la première valeur (D2) :

c:\a\N47495pdf c:\a\ est le chemin, N47495 est le nom et pdf l'extension. Il doit toujours y avoir un point entre le fichier et son extension : N47495.pdf.

Ta liste devrait être du type :
c:\a\N47495.pdf
c:\b\N31320-02.pdf etc

Ci-joint le fichier modifié en conséquence avec la macro.

A+ Jack2

 

[lepigoennier]

Re : Enregistrer un PDF/DOC/JPG à partir d'Excel

Il y a des . devant l'extension dans le fichier original. C'est une erreur de ma part quand j'ai modifié les noms. Toutefois, ça ne fonctionne toujours pas. Je te remercie pour ton temps, mais je vais faire ouvrir les liens aux gens et ils n'auront qu'à l'enregistrer.

 

[Jack2]

Re : Enregistrer un PDF/DOC/JPG à partir d'Excel

Bonsoir lepigoennier,

Je ne comprends pas, chez moi ça marche quelle que soit la version d'Excel. Est-ce que tu as coché Microsoft Scripting Runtime? Dans l'éditeur de macro (Alt+F11) aller dans Outils, puis Références et cocher Microsoft Scripting Runtime[ dans la boite de dialogue.

Si ça ne marche pas, j'essayerais de te trouver une autre solution.

A+ Jack2

 

[lepigoennier]

Re : Enregistrer un PDF/DOC/JPG à partir d'Excel

Ça marche merci. Par contre, ça bogue si le fichier ne semble pas exister pour la macro ( je sais qu'il existe et que le lien fonctionne car testé). Est-ce que tu connaîtrais un ligne de code qui me permet de passer par dessus s'il ne trouve pas?

Encore un gros merci.

 

[Jack2]

Re : Enregistrer un PDF/DOC/JPG à partir d'Excel

Bonjour lepigoennier;

Content que ça marche. Pour éviter que ça ne passe pas, essaye :

On error Resume Next
 FSO.CopyFile Rep_Init & NomFich, Rep_Fin & NomFich, True

ou

On error Resume Next
On error goto Erreur
 FSO.CopyFile Rep_Init & NomFich, Rep_Fin & NomFich, True
Erreur:
Err.clear

A+ Jack 2

 

[lepigoennier]

Re : Enregistrer un PDF/DOC/JPG à partir d'Excel

Merci, merci, merci beaucoup et Joyeux Noël