Problème d'ouverture de fichiers en série pour impression en pdf

Version imprimable

Bonjour,

J'ai fait une petite procédure pour imprimer (ou plutôt exporter) une série de fichier xlsx en pdf.

Je la teste sur une série de 88 fichiers.

Dans le principe elle fonctionne plutôt bien, seulement parfois et de façon aléatoire elle s'arrête en me générant un message:

Citation:

Erreur d'exécution '1004':
La méthode 'Open' de l'objet 'Workbooks' a échoué

Le débogueur me surligne la ligne 39: Set wb = Workbooks.Open(chemin & "\" & fichier).

Je n'arrive pas à comprendre pourquoi.

J'ai même tenté de mettre une temporisation (Sleep (100) ligne 45) en me disant que le précédant fichier n'avait peut-être pas eu le temps de se refermer correctement mais ça ne change rien (j'ai essayé jusqu'à 2s)

Elle a fonctionné de bout en bout qu'une seule fois.

Une Idée?

Mon 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
Option Explicit
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
 
'Ouvre et imprime des fichiers xlsx d'un dossier choisi en pdf dans un sous dossier "PDF"
Public Sub ImprimerFeuilles()
    Dim wb          As Workbook
    Dim fichier     As String
    Dim chemin      As String
    Dim compteur    As Integer
 
    If ThisWorkbook.Path = chemin Then
      MsgBox "Ne pas mettre le classeur contenant le programme dans le dossier " & chemin
      Exit Sub
    End If
 
    MsgBox "Sélectinnez le dossier ou se trouvent les fichiers à imprimer"
 
    'Ouverture d'un explorateur de dossier pour sélectionner le dossier
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        If .SelectedItems.Count > 0 Then
        chemin = .SelectedItems(1)
        End If
    End With
 
    'Test si sous-dossier PDF existe; si non le créer
    If Len(Dir(chemin & "\PDF", vbDirectory)) <= 0 Then
       MkDir (chemin & "\PDF")
    End If
 
    fichier = Dir(chemin & "\*.xlsx")
 
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
 
    Do While fichier <> ""
        Set wb = Workbooks.Open(chemin & "\" & fichier)
        wb.Sheets(1).ExportAsFixedFormat Type:=xlTypePDF, Filename:=chemin & "\PDF\" & fichier & ".pdf"
        wb.Close
        Set wb = Nothing
        compteur = compteur + 1
        fichier = Dir
        Sleep (100)
    Loop
 
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
 
    MsgBox compteur & " Fichiers ont été traités"
End Sub

08/06/2021, 21h12
Jean-Philippe André

Salut,

que te donne exactement chemin & "\" & fichier ?

ajoute un

Code:

Debug.Print chemin & "\" & fichier

et commence par vérifier que le chemin est correct.
09/06/2021, 13h55
CeluiQuiCherche

Bonjour Jean-Philippe,

je viens de terminer toute un série de tests sur les chemins et noms de fichiers.

Les noms des chemins\fichiers de ceux qui plantent ne différent pas des autres.

J'ai raccourci les chemins, au lieu de tester depuis le bureau avec l'imbrication de tous les sous-dossiers je me suis mis directement sur C:

Cela a eu l'air de fonctionné une fois puis ça a replanté toutes les fois suivantes.

J'ai analyser les noms des chemins et fichiers en hexa, des fois qu'un caractère non imprimable se soit glissé dedans --> rien.

Puis je me suis intéressé à la documentation de la fonction Dir que j'utilise sans spécialement la connaitre.
https://docs.microsoft.com/fr-fr/off...6)%26rd%3Dtrue

Et là je ne suis pas optimiste en lisant l'extrait ci-après même si je suis sous Windows 10 avec office 2019!

Citation:

Avec Excel pour Mac 2016, l’appel de la fonctionDir initiale réussit. Toutefois, les appels ultérieurs à itérer dans le répertoire spécifié entraînent une erreur. Il s’agit malheureusement d’un bogue connu.