Déplacer et renommer un fichier PDF ouvert avec VBA excel

Version imprimable

J'ai ouvert un fichier PDF avec VBA excel, je voudrais le renommer et l'enregistrer sous un répertoire x...... et nom y avec une VBA excel.
Pouvez vous m'aider

En vous remerciant d'avance.

PS je ne suis vraiment pas doué en VBA.

Voici mon code

Merci

Code:

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
Option Explicit
 
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOWNORMAL = 1
 
Sub SelectionFichier()
Dim Fichier As Variant
    ChDir ThisWorkbook.Path & "\"
    Fichier = Application.GetOpenFilename("Fichier PDF (*.pdf), *.pdf")
    If Fichier <> False Then OuvrirPDF (Fichier)
 
End Sub
 
Private Sub OuvrirPDF(sFichier As String)
Dim hwnd As Long
ShellExecute hwnd, "Open", sFichier, 0&, 0&, SW_SHOWNORMAL
 
 
'ici il me faudrait le code qui vas bien save as !!!!!!!!!!!!!!
 
 
 
KillAcrobat
 
End Sub
 
Private Sub KillAcrobat()
Dim Rep As Variant
    Rep = Shell("Taskkill /im Acrobat.exe /f", 0)
End Sub

26/12/2018, 09h24
Menhir

En somme, tu veux le copier, non ?
Pour faire ça, pas besoin de l'ouvrir. Il suffit d'utiliser l'instruction FileCopy.
https://docs.microsoft.com/fr-fr/off...copy-statement

Petit détail : même si c'est une macro VBA dans Excel qui déclenche l'ouverture, le fichier n'est pas ouvert avec Excel, il est ouvert avec ton viewer de PDF par défaut.
Donc, si tu voulais l'enregistrer sous un autre nom avec cette méthode, il faudrait manipuler des objets de la bibliothèque de ce viewer, ce qui serait beaucoup plus compliqué que la méthode que je propose.

Après avoir adapté le code de KIKI29, voila ce que j'ai trouvé

Bonjour,

Je suis vraiment un bleu dans la programmation VBA mais j'ai comme référence la bible de KIKI29
"Ecriture dans les champs d'un formulaire PDF à partir d'une feuille Excel"
et j'ai adapter.

Voila ce que j'ai trouvé et cela a l'air de marcher.

Code:

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
Sub TransferPDF_Excel()
Dim Fichier1 As Variant
    ChDir ThisWorkbook.Path & "\"
    Fichier1 = Application.GetOpenFilename("Fichiers PDF (*.pdf), *.pdf", Title:="Sélection PDF")
    If Fichier1 = False Then Exit Sub
Dim AVDoc As Object
Dim sChemin As String
Dim PDDoc As Object
Dim JSO As Object
Dim X As Object
    Set AVDoc = CreateObject("AcroExch.AVDoc")
    sChemin = Fichier1
 
    If AVDoc.Open(sChemin, "") Then
        Set PDDoc = AVDoc.GetPDDoc
        Set JSO = PDDoc.GetJSObject
        PDDoc.Save 1, ThisWorkbook.Path & "\" & "PICKDATA" & ".pdf"
        PDDoc.Close
        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

Merci pour votre aide.

Bien à vous