Erreur n°1004 - Fichier introuvable
Bonjour,
le but de cette macro est de récupérer chaque fichier *.xlxm dans le répertoire MAR, d'effectuer quelques modifications dessus et de l'enregistrer dans un autre répertoire FAB en *.xlsx.
Cela marche de temps en temps et parfois j'ai ce message :
Erreur n°1004 - Fichier introuvable. Vérifiez l'orthographe du nom du classeur et la validité de l'emplacement.
Or mes fichiers se trouvent bien à l'emplacement indiqué. et le débogage m'envoie sur la ligne suivante :
Workbooks.Open Filename:=CheminMAR & Fichier
Sub Pour_FAB()
Dim CheminMAR As String
Dim CheminFAB As String
Dim Fichier As String
Dim i As Long
Dim S As Integer
Application.DisplayAlerts = False
CheminMAR = ThisWorkbook.Path & "\MAR\"
CheminFAB = ThisWorkbook.Path & "\FAB\"
If Dir(CheminFAB, 16) = "" Then MkDir CheminFAB
Fichier = Dir(CheminMAR & "*.xlsm")
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Do While Fichier <> ""
For i = 1 To Sheets.Count
Workbooks.Open Filename:=CheminMAR & Fichier
'Suppression des lignes en trop
For S = 4 To Sheets.Count 'à partir de la 4e feuille
ActiveWorkbook.Sheets(S).Select 'Sélectionner toutes les feuilles
Rows(1).EntireRow.Delete Shift:=xlUp
Rows(2).EntireRow.Delete Shift:=xlUp
Next S
Sheets(Array("Index", "GAB_1", "GAB_2")).Select
Sheets("GAB_2").Activate
ActiveWindow.SelectedSheets.Delete
ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents("Import_DATA")
newname = Replace(ActiveWorkbook.Name, ".xlsm", "")
ActiveWorkbook.SaveAs Filename:=CheminFAB & newname & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False 'renommer
ActiveWorkbook.Close
Fichier = Dir
Next i
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Quit
End Sub
En fait cela plante au dernier classeur.
Quelqu'un aurait il une idée ?
Bonne journée à tous
Il semblerait que ce soit au niveau de la chaîne de caractères que le problème se situe.
Comment faire pour ne pas prendre en compte les espaces dans les noms de fichiers.
Bonjour
A vérifier le nom du fichier lorsque il y a plantage
Passes ton curseur sur le mot "Fichier" tu devrais voir le nom du fichier en ControlTipText
Sinon dans la fenêtre exécution tapes
? fichier ---> entrée
Tu auras son nom et compares le avec les noms des fichiers dans ton répertoire
Bonjour
Je trouve ton code un peu bizarre : Le fait que dans une boucle For i = 1 To Sheets.Count
tu ouvres un fichier
Mais comme je n'ai pas ton/tes fichier(s), c'est peut-être normal
Je rajouterai la ligne surlignée
Sub Pour_FAB()
Dim CheminMAR As String
Dim CheminFAB As String
Dim Fichier As String
Dim i As Long
Dim S As Integer
Application.DisplayAlerts = False
CheminMAR = ThisWorkbook.Path & "\MAR\"
CheminFAB = ThisWorkbook.Path & "\FAB\"
If Dir(CheminFAB, 16) = "" Then MkDir CheminFAB
Fichier = Dir(CheminMAR & "*.xlsm")
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Do While Fichier <> ""
For i = 1 To Sheets.Count
Workbooks.Open Filename:=CheminMAR & Fichier
'Suppression des lignes en trop
For S = 4 To Sheets.Count 'à partir de la 4e feuille
ActiveWorkbook.Sheets(S).Select 'Sélectionner toutes les feuilles
Rows(1).EntireRow.Delete Shift:=xlUp
Rows(2).EntireRow.Delete Shift:=xlUp
Next S
Sheets(Array("Index", "GAB_1", "GAB_2")).Select
Sheets("GAB_2").Activate
ActiveWindow.SelectedSheets.Delete
ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents("Import_DATA")
newname = Replace(ActiveWorkbook.Name, ".xlsm", "")
ActiveWorkbook.SaveAs Filename:=CheminFAB & newname & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False 'renommer
ActiveWorkbook.Close
Fichier = Dir
If Dir = "" Then Exit Do
Next i
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Quit
End Sub
Merci encore,
En fait tu m'as mis sur la voie.
Le For I et Next i ne servent à rien.
Sub Pour_FAB()
Dim CheminMAR As String
Dim CheminFAB As String
Dim Fichier As String
Dim i As Long
Dim S As Integer
Application.DisplayAlerts = False
CheminMAR = ThisWorkbook.Path & "\MAR\"
CheminFAB = ThisWorkbook.Path & "\FAB\"
If Dir(CheminFAB, 16) = "" Then MkDir CheminFAB
Fichier = Dir(CheminMAR & "*.xlsm")
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Do While Fichier <> ""
'For i = 1 To Sheets.Count
Workbooks.Open Filename:=CheminMAR & Fichier
'Suppression des lignes en trop
For S = 4 To Sheets.Count 'à partir de la 4e feuille
ActiveWorkbook.Sheets(S).Select 'Sélectionner toutes les feuilles
Rows(1).EntireRow.Delete Shift:=xlUp
Rows(2).EntireRow.Delete Shift:=xlUp
Next S
Sheets(Array("Index", "GAB_1", "GAB_2")).Select
Sheets("GAB_2").Activate
ActiveWindow.SelectedSheets.Delete
ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents("Import_DATA")
newname = Replace(ActiveWorkbook.Name, ".xlsm", "")
ActiveWorkbook.SaveAs Filename:=CheminFAB & newname & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False 'renommer
ActiveWorkbook.Close
Fichier = Dir
'Next i
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Quit
End Sub