Erreur 1004

Bonjour,

l'exécution de cette macro me donne un erreur 1004 sur le ligne "Wbk.SaveAs Filename:=fichier" (je travaille sur excel 2013)

merci de m'aider :

Sub fichedevie()

Dim a As String, i As Integer, ligne As Integer

Do

ligne = ligne + 1

Loop Until Cells(ligne, 6) = ""

ligne = ligne - 1

Dim Xl As Excel.Application, Wbk As Excel.Workbook

Dim NomFich As String

Dim chemin As String, fichier As String

NomFich = "C:\Users\Dream\Desktop\fiche de vie Moule\Fiche.xlsx"

Set Xl = New Excel.Application

Xl.Visible = False

Set Wbk = Xl.Workbooks.Open(NomFich)

For i = 1 To ligne

a = Cells(i, 6)

chemin = "C:\Users\Dream\Desktop\fiche de vie Moule"

fichier = chemin & "\" & a & ".xls"

Wbk.SaveAs Filename:=fichier

Next i

Wbk.Close

Xl.Quit

End Sub

Bonjour,

un des noms de fichier créé sur base d'une des cellules en colonne F n'est pas correct, caractères invalides ou quelque chose du genre.

sinon peux-tu nous mettre ton fichier ?

l'erreur s'affiche quand j'ai des cellules ont les même valeurs

Bonsoir,

pas de problème avec ta macro, après avoir corrigé le test d'une cellule blanche, qui faisait qu'aucun fichier n'était créé.

j'ai fait d'autres modifications à ton code, mais il fonctionnait sans ces autres modifs.

tu dois sélectionner la feuille sheet1 avant de lancer ta macro.

'création de la fiche de vie de chaque outil

Sub fichedevie()

Dim a As String, i As Integer, ligne As Integer

' boucle pour compter le nombre de ligne

ligne = Cells(Rows.Count, 6).End(xlUp).Row

Dim Xl As Excel.Application, Wbk As Excel.Workbook

Dim NomFich As String

Dim chemin As String, fichier As String

NomFich = "C:\Users\Dream\Desktop\fiche de vie Moule\Fiche.xlsx" '<-- adapter chemin et nom du fichier excel à ouvrir

Set Xl = New Excel.Application

Xl.Visible = False '<-- excel reste invisible

Set Wbk = Xl.Workbooks.Open(NomFich) 'ouvrir le fichier excel "fiche"

'copier le ficher excel "fiche" et renommer par le nom de cellule

chemin = "C:\Users\Dream\Desktop\fiche de vie Moule" ' adapter le chemin de dossier

For i = 1 To ligne ' fiche de des moules

a = Cells(i, 6)

If a = "" Then a = "a"

fichier = chemin & "\" & a & ".xls" ' le nom de chaque fichier

Wbk.SaveAs Filename:=fichier

Next i

Wbk.Close ' fermer le fichier excel "fiche"

Xl.Quit

End Sub

bonjour,

merci, mais après la modification, reste l'erreur 1004 m'affiche "Méthode ' SaveAS' of object '_Workbook' failed"

quand j'ai répéter l'exécution de macro une autre fois

elyane a écrit :

bonjour,

merci, mais après la modification, reste l'erreur 1004 m'affiche "Méthode ' SaveAS' of object '_Workbook' failed"

quand j'ai répéter l'exécution de macro une autre fois

bonjour,

ai-je bien compris que ta macro fonctionne bien la première fois que tu l'exécutes , mais que tu as l'erreur quand tu l'exécutes une deuxième fois ?

Oui exactement .

Et quand tu fermes et puis ouvres à nouveau excel et ton classeur ?

Oui, le même erreur aussi dans ce cas .

bonjour,

si le fichier existe tu reçois un message te demandant si tu veux remplacer le fichier.

si tu réponds non et que tu n'as pas de traitement d'erreur, tu as l'erreur 1004 qui s'affiche.

Merci,

Comment je peux faire le traitement d'erreur?

Cordialement

différentes possibilités,

voici une proposition

modifie ton instruction wbk.saveas ainsi, pour que l'erreur ne se produise pas.

If Dir(fichier) = "" Then Wbk.SaveAs Filename:=fichier

Merci bien, pas d'erreur

bonjours,

Est ce que tu a une idée sur lien hypertexte ?

Je veux améliorer mon code et je dois faire un lien hypertexte entre la cellule est son fichier que j'ai crée dans le code précédent

merci d'avance

Bonsoir,

code adapté pour insérer l'hyperlien vers le fichier créé.

'création de la fiche de vie de chaque outil
Sub fichedevie()
Dim a As String, i As Integer, ligne As Integer
' boucle pour compter le nombre de ligne
ligne = Cells(Rows.Count, 6).End(xlUp).Row
ActiveSheet.Hyperlinks.Delete
Dim Xl As Excel.Application, Wbk As Excel.Workbook
Dim NomFich As String
Dim chemin As String, fichier As String
NomFich = "C:\Users\Dream\Desktop\fiche de vie Moule\Fiche.xlsx" '<-- adapter chemin et nom du fichier excel à ouvrir
NomFich = "e:\n1\fiche.xlsx"
Set Xl = New Excel.Application
Xl.Visible = False '<-- excel reste invisible
Set Wbk = Xl.Workbooks.Open(NomFich) 'ouvrir le fichier excel "fiche"

'copier le ficher excel "fiche" et renommer par le nom de cellule
chemin = "C:\Users\Dream\Desktop\fiche de vie Moule" ' adapter le chemin de dossier
chemin = "e:\n1"
For i = 1 To ligne ' fiche de des moules
a = Cells(i, 6)
If a = "" Then a = "a"

fichier = chemin & "\" & a & ".xls" ' le nom de chaque fichier

ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 6), Address:=fichier, TextToDisplay:=Cells(i, 6).Value

If Dir(fichier) = "" Then Wbk.SaveAs Filename:=fichier
Next i
Wbk.Close ' fermer le fichier excel "fiche"
Xl.Quit
End Sub

Merci beaucoup ,

Le code fonctionne correctement.

Mon dernier demande s'il vous plait. Tu peut m'aider? Je veux faire remplir une cellule dans le fichier avec le nom de fichier lors de l'enregistrement dans ce code.

Cordialement.

bonsoir,

quelle cellule ? dans quel fichier ?

Bonsoir,

Dans les fichier que j'ai les enregistrer et je les renommer avec les contenu des cellules alors j veux réécrire le nom de chaque fichier que j'ai les enregistrer à l'intérieur de ces fichier dans une cellule B6.

C'est à dire dans le code précédent je dois ajouter lors de l'enregistrement de ce fichier "fichier = chemin & "\" & a & ".xls"" je veux remplir une cellule B6 à l'intérieur de ce fichier avec son nom.

bonjour,

dans quelle feuille ?

s'il n'y a qu'une feuille voici une proposition de code adapté. sinon remplacer le 1 dans wbk.sheets(1).range("B6") par

wbk.sheets("nom de la feuille").range("B6") dans le code ci-dessous.

le nom du fichier est ajouté dans les nouveaux fichiers créés, pas dans les fichiers qui existeraient déjà. Je te conseille donc de supprimer tous les fichiers que tu as créés avec les versions précédentes de cette macro, avant de lancer cette nouvelle version de la macro.

'création de la fiche de vie de chaque outil
Sub fichedevie()
Dim a As String, i As Integer, ligne As Integer
' boucle pour compter le nombre de ligne
ligne = Cells(Rows.Count, 6).End(xlUp).Row
ActiveSheet.Hyperlinks.Delete
Dim Xl As Excel.Application, Wbk As Excel.Workbook
Dim NomFich As String
Dim chemin As String, fichier As String
NomFich = "C:\Users\Dream\Desktop\fiche de vie Moule\Fiche.xlsx" '<-- adapter chemin et nom du fichier excel à ouvrir
Set Xl = New Excel.Application
Xl.Visible = False '<-- excel reste invisible
Set Wbk = Xl.Workbooks.Open(NomFich) 'ouvrir le fichier excel "fiche"

'copier le ficher excel "fiche" et renommer par le nom de cellule
chemin = "C:\Users\Dream\Desktop\fiche de vie Moule" ' adapter le chemin de dossier

For i = 1 To ligne ' fiche de des moules
a = Cells(i, 6)
If a = "" Then a = "a"

fichier = chemin & "\" & a & ".xls" ' le nom de chaque fichier

ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 6), Address:=fichier, TextToDisplay:=Cells(i, 6).Value

If Dir(fichier) = "" Then
 Wbk.Sheets(1).Range("B6") = fichier
 Wbk.SaveAs Filename:=fichier
End If
Next i
Wbk.Close ' fermer le fichier excel "fiche"
Xl.Quit
End Sub

Bonjour,

Merci infiniment pour votre aide, le code fonctionne correctement et comme je le veux exactement

Est ce que j peux remplir d'autre cellule au même temps?

Voici cette modification. Elle est correcte?

'création de la fiche de vie de chaque outil
Sub fichedevie()
Dim a As String, i As Integer, ligne As Integer
Dim plan As String
' boucle pour compter le nombre de ligne
ligne = Cells(Rows.Count, 6).End(xlUp).Row
ActiveSheet.Hyperlinks.Delete
Dim Xl As Excel.Application, Wbk As Excel.Workbook
Dim NomFich As String
Dim chemin As String, fichier As String
NomFich = "C:\Users\Dream\Desktop\fiche de vie Moule\Fiche.xlsx" '<-- adapter chemin et nom du fichier excel à ouvrir
Set Xl = New Excel.Application
Xl.Visible = False '<-- excel reste invisible
Set Wbk = Xl.Workbooks.Open(NomFich) 'ouvrir le fichier excel "fiche"

'copier le ficher excel "fiche" et renommer par le nom de cellule
chemin = "C:\Users\Dream\Desktop\fiche de vie Moule" ' adapter le chemin de dossier

For i = 1 To ligne ' fiche de des moules
a = Cells(i, 6)
plan = cells(i,3)
If a = "" Then a = "a"

fichier = chemin & "\" & a & ".xls" ' le nom de chaque fichier

ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 6), Address:=fichier, TextToDisplay:=Cells(i, 6).Value

If Dir(fichier) = "" Then
 Wbk.Sheets(1).Range("B6") = fichier
Wbk.Sheets(1).Range("B11") = plan
 Wbk.SaveAs Filename:=fichier
End If
Next i
Wbk.Close ' fermer le fichier excel "fiche"
Xl.Quit
End Sub