impression plusieurs PDF via VBA

Version imprimable

Bonjour, comme indiqué dans le titre j'ai fait une macro (avec différents bouts de codes) qui vise a imprimer tous les pdf contenus dans un dossier.

Mais ça plante dans la fonction "ImprimerFichier" avec une erreur d'execution '91' : variable objet ou variable bloc with non definie. Tout le reste fonctionne, les chemins sont corrects et pointent bien vers les pdf en question.

J'ai cherché une réponse qui corresponde a cette problématique et la fonction "imprimerFichier" est la seule que j'ai pu trouver.

Voici le code :

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
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
Sub ListeFichiers(Repertoire As String)
    '
    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
        'Dans l'éditeur de macros (Alt+F11):
        'Menu Outils
        'Références
        'Cochez la ligne "Microsoft Scripting RunTime".
        'Cliquez sur le bouton OK pour valider.
 
    Dim Fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim i As Long
 
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)
 
    'Boucle sur tous les fichiers du répertoire
    Application.Dialogs(xlDialogPrinterSetup).Show
    For Each FileItem In SourceFolder.Files
        'Inscrit le nom du fichier dans la cellule
 
        If Right(FileItem.Name, 3) = "pdf" Then
        ImprimerFichier (FileItem.ParentFolder & FileItem.Name)
 
        Else
        End If
 
    Next FileItem
 
 
    '--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
    For Each SubFolder In SourceFolder.subfolders
        ListeFichiers SubFolder.Path
    Next SubFolder
 
End Sub
 
 
Sub lance_impr()
Dim Repertoire As FileDialog
Dim chemin As String
 
Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
Repertoire.Show
chemin = Repertoire.SelectedItems(1)
ListeFichiers (chemin)
End Sub
 
 
 
Public Function ImprimerFichier(FichierAImprimer As String)
 
    CreateObject("Shell.Application").Namespace(0).ParseName(FichierAImprimer).InvokeVerb ("Print")
End Function

edit : solution non trouvée

Après avoir bien fouillé j'ai trouvé le bout de code qui me faisait défaut. Je vous mets ci dessous un code qui permet a l'utilisateur de sélectionner un dossier et imprimer tous les pdf qui se trouvent a l'intérieur.

Il y a une petite sécurité quand le nombre d'impression dépasse les 9 pages avec demande à l'utilisateur si il est sur de vouloir imprimer.

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
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
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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
 
Sub lance_impr()
Dim Repertoire As FileDialog
Dim chemin As String
 
Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
Repertoire.Show
chemin = Repertoire.SelectedItems(1)
ListeFichiers (chemin)
End Sub
Sub ListeFichiers(Repertoire As String)
    '
    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
        'Dans l'éditeur de macros (Alt+F11):
        'Menu Outils
        'Références
        'Cochez la ligne "Microsoft Scripting RunTime".
        'Cliquez sur le bouton OK pour valider.
 
    Dim Fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim i As Long
    Dim reponse As Integer
 
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)
 
 
    'Application.Dialogs(xlDialogPrinterSetup).Show
 
    i = 0
    For Each FileItem In SourceFolder.Files
 
       'recherche des pdf
        If Right(FileItem.Name, 3) = "pdf" Then
        i = i + 1
        Else
        End If
 
    Next FileItem
 
    'demande à l'utilisateur si plus de 9 pages
    If i > 9 Then
        reponse = MsgBox("Vous allez imprimer " & i & " feuilles, etes vous sur de vouloir continuer ?", vbYesNo, "Nombre important d'impressions")
        If reponse = 7 Then
    GoTo fin
    Else
    End If
    Else
    End If
 
'imprime tous les pdf du dossier
    For Each FileItem In SourceFolder.Files
        'Inscrit le nom du fichier dans la cellule
 
        If Right(FileItem.Name, 3) = "pdf" Then
        ImprimerFichier (FileItem.ParentFolder & FileItem.Name)
 
        Else
        End If
 
    Next FileItem
 
 
    '--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
    For Each SubFolder In SourceFolder.subfolders
        ListeFichiers SubFolder.Path
    Next SubFolder
fin:
End Sub
 
 
Function ImprimerFichier(ByVal Fichier As String)
    ShellExecute FindWindow("XLMAIN", Application.Caption), "print", Fichier, "", "", 1
    Application.Wait (Now + TimeValue("0:00:03")) 'on laisse le temps a la fenetre pdf application(celle que tu utilise comme reader) de s'ouvrir (on a pas le temps de la voir!!)
     Shell "Taskkill /im AcroRd32.exe /f", 0
End Function

Le script s’exécute bien, aucune erreur, mais pas d'impression.... La ligne shellExecute n'as pas l'ai de lancer l'impression (ligne 80).

Par contre je n'ai pas encore trouvé comment mettre un focus sur le filedialog pour ouvrir toujours la même racine de dossier afin d'éviter de fouiller... Si quelqu'un a la réponse, qu'il la poste !

Essai la fonction suivante:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
Sub ImprimerFichier(ByVal PDFfilename As String)
' Imprimer un fichier PDF avec Acrobat Reader DC
Dim AcrReadPath As String
Dim oShell As Object
Dim oExec As Object
    Set oShell = CreateObject("Wscript.Shell")
    AcrReadPath = "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe"
    Set oExec = oShell.exec("""" & AcrReadPath & """/p /h """ & PDFfilename & """")
    Application.Wait Now + TimeSerial(0, 0, 2)
    DoEvents
    oExec.Terminate
    Set oExec = Nothing
    Set oShell = Nothing
End Sub

03/03/2021, 10h44
bbosch

fichier introuvable par acrobat

Salut et merci de la fonction, elle ouvre AR. Par contre, la variable "PDFfilename" correspond a quoi ? au chemin de mon fichier pdf ? si c'est le cas acrobat me retourne que le fichier est introuvable
03/03/2021, 12h36
bbosch

OK ca fonctionne, c'est juste qu'a la ligne 63

Code:

ImprimerFichier (FileItem.ParentFolder & FileItem.Name)

j'ai oublié de rajouté le "\" etre les deux.... erreur basique mais chiante

Il faut donc mettre

Code:

ImprimerFichier (FileItem.ParentFolder & "\" & FileItem.Name)

pour que le chemin soit correct.

Par contre j'ai une erreur d'execution a la ligne

Code:

oExec.Terminate

de ton code, comme quoi la fonction a échoué.

Ok c'est bon

Bon voila je suis enfin arrivé a faire ce code qui imprime tous les pdf d'un dossié selectionné par l'utilisateur.

J'ai du mettre une commande pour kill acrobat reader a la fin pour fermer mes fenetres.

J'ai également du augmenter la tempo de chaque impression en la passant a 10 secondes pour éviter de sauter les dernieres impression en refermant trop vite acrobat.

Voila le code

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
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
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
Option Explicit
 
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
Private Declare PtrSafe 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
 
 Sub lance_impr()
Dim Fdialog As FileDialog
Dim chemin As String
 
On Error GoTo fin
'initialisation de l'ouverture dossier
Set Fdialog = Application.FileDialog(msoFileDialogFolderPicker)
With Fdialog
    '.AllowMultiSelect (False)
    '.Title ("Selectionner un dossier pour imprimer les pdf présents à l'intérieur")
    .Show
End With
 
chemin = Fdialog.SelectedItems(1)
ListeFichiers (chemin)
fin:
End Sub
Sub ListeFichiers(Repertoire As String)
 
    'Nécessite d'activer la référence "Microsoft Scripting RunTime"
        'Dans l'éditeur de macros (Alt+F11):
        'Menu Outils
        'Références
        'Cochez la ligne "Microsoft Scripting RunTime".
        'Cliquez sur le bouton OK pour valider.
 
    Dim Fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim SubFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim i As Long
    Dim reponse As Integer
    Dim cheminAcces As String
    Dim msg As String
 
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)
 
 
    'Application.Dialogs(xlDialogPrinterSetup).Show
 
    i = 0
    For Each FileItem In SourceFolder.Files
 
       'recherche des fichiers pdf
        If Right(FileItem.Name, 3) = "pdf" Then
        i = i + 1
        Else
        End If
 
    Next FileItem
 
    'Demande validation de l'utilisateur si plus de 9 pages
    If i > 9 Then
        reponse = MsgBox("Vous allez imprimer " & i & " documents, etes vous sur de vouloir continuer ?", vbYesNo, "Nombre important d'impressions")
        If reponse = 7 Then
    GoTo fin
    Else
    End If
    Else
    End If
 
    For Each FileItem In SourceFolder.Files
 
       'impression des fichiers pdf
        If Right(FileItem.Name, 3) = "pdf" Then
        cheminAcces = FileItem.ParentFolder & "\" & FileItem.Name
        ImprimerFichier (cheminAcces)
 
        Else
        End If
 
    Next FileItem
 
CreateObject("Wscript.Shell").Run "taskkill.exe /IM AcroRd32.exe /T /F", 0
msg = MsgBox("Vous avez imprimé " & i & " documents", vbInformation, "Impression")
fin:
End Sub
 
 
Sub ImprimerFichier(ByVal PDFfilename As String)
' Imprimer un fichier PDF avec Acrobat Reader DC
Dim AcrReadPath As String
Dim oShell As Object
Dim oExec As Object
    Set oShell = CreateObject("Wscript.Shell")
    AcrReadPath = "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe"
    Set oExec = oShell.exec("""" & AcrReadPath & """/p /h """ & PDFfilename & """")
    Application.Wait Now + TimeSerial(0, 0, 10)
    DoEvents
    Set oExec = Nothing
    Set oShell = Nothing
End Sub

Si vous voulez faites juste un copier coller et n'oubliez pas d'activer la bibliotheques de references "Microsoft Scripting RunTime" pour faire la recherche de pdf. J'ai également mis une sécurité en cas d'impression tres volumineuses avec une validation utilisateur a plus de 9 documents.

J'ai aussi mis une msgbox a la fin qui indique le nombre de document lancé en impression.

a+ et merci