Erreur d'exécution 1004

Le 02/11/2015 à 11:16

Bonjour à tous!

Je sollicite votre appui pour la résolution de mon problème. J'ai créé un macro qui affiche le message suivant: "Erreur d'exécution 1004, désolé nous ne trouvons pas fichier.xlsx. Peut être vous l'avez déplacé, renommé ou supprimé". Le problème se situe au niveau de Workbooks.Open Nomfichier

Voici la syntax

Sub Synthèse()

'Macro permettant de créer une synthèse des succursales

'Effacement de la feuille

Cells.Delete

'Ecriture de la ligne de titre

Range("A1") = "Région"

Range("B1") = "Immeuble"

Range("C1") = "Nombre"

'Mise en forme de la ligne titre

Range("A1:C1").Interior.Color = 13434879

Range("A1:C1").Font.Bold = True

Nomfichier = Dir("C:\Users\user nm\Desktop\Pojet Ges BD\succursales\*.xlsx")

While Len(Nomfichier) > 0

Workbooks.Open Nomfichier

AVL = ActiveSheet.UsedRange.Rows.Count - 1

Range("A2:B" & AVL).Copy

Workbooks("Recap.xlsm").Activate

DNF = ActiveSheet.UsedRange.Rows.Count + 1

Range("B" & ActiveSheet.UsedRange.Rows.Count + 1).Select

ActiveSheet.Paste

Range("A" & DNF & ":A" & ActiveSheet.UsedRange.Rows.Count) = Nomfichier

Workbooks(Nomfichier).Close (savechanges = "False")

Nomfichier = Dir

Wend

Columns("A:A").Replace ".xlsx", ""

Cells.EntireColumn.AutoFit

Range("A1").Select

End Sub

Merci d'avance!

Le 02/11/2015 à 11:35

Bonjour et bienvenu(e)

Sur quelle ligne se produit l'erreur ?

Ce que j'ai trouvé d'anormal dans le code

Workbooks(Nomfichier).Close (savechanges = "False")

normalement cela serait

Workbooks(Nomfichier).Close savechanges:=False
Le 02/11/2015 à 11:46

Merci. L'erreur 1004 persiste. elle se situe à ce niveau (surligné). Veuillez m'apporter votre aide.

Sub Synthèse()

'Macro permettant de créer une synthèse des succursales

'Effacement de la feuille

Cells.Delete

'Ecriture de la ligne de titre

Range("A1") = "Région"

Range("B1") = "Immeuble"

Range("C1") = "Nombre"

'Mise en forme de la ligne titre

Range("A1:C1").Interior.Color = 13434879

Range("A1:C1").Font.Bold = True

Nomfichier = Dir("C:\Users\user nm\Desktop\Pojet Ges BD\succursales\*.xlsx")

While Len(Nomfichier) > 0

Workbooks.Open Nomfichier

AVL = ActiveSheet.UsedRange.Rows.Count - 1

Range("A2:B" & AVL).Copy

Workbooks("Recap.xlsm").Activate

DNF = ActiveSheet.UsedRange.Rows.Count + 1

Range("B" & ActiveSheet.UsedRange.Rows.Count + 1).Select

ActiveSheet.Paste

Range("A" & DNF & ":A" & ActiveSheet.UsedRange.Rows.Count) = Nomfichier

Workbooks(Nomfichier).Close (savechanges = "False")

Nomfichier = Dir

Wend

Columns("A:A").Replace ".xlsx", ""

Cells.EntireColumn.AutoFit

Range("A1").Select

End Sub

Merci

Le 02/11/2015 à 15:29

Bonjour

Sans support toujours pas évident

Sans conviction (mais bon faut essayer)

Testes

Workbooks.Open "C:\Users\user nm\Desktop\Pojet Ges BD\succursales\" & Nomfichier
Le 02/11/2015 à 16:13

Voici en attache le dossier contenant les fichiers. Merci d'avance

10succursales.rar (59.39 Ko)
Le 02/11/2015 à 16:30

Bonjour

C'était bien la solution que je t'ai proposée dans mon précédent message

A tester

Sub Synthèse()
'Macro permettant de créer une synthèse des succursales
'Effacement de la feuille
  Cells.Delete
  Dim Chemin As String

  Application.ScreenUpdating = False

  'Ecriture de la ligne de titre
  Range("A1") = "Région"
  Range("B1") = "Immeuble"
  Range("C1") = "Nombre"

  'Mise en forme de la ligne titre
  Range("A1:C1").Interior.Color = 13434879
  Range("A1:C1").Font.Bold = True

  Chemin = ThisWorkbook.Path & "\"        ' Chemin pour mes tests
  'Chemin = "C:\Users\user nm\Desktop\Pojet Ges BD\succursales\"  ' Ton chemin
  Nomfichier = Dir(Chemin & "*.xlsx")
  While Len(Nomfichier) > 0
    Workbooks.Open Chemin & Nomfichier
    AVL = ActiveSheet.UsedRange.Rows.Count - 1
    Range("A2:B" & AVL).Copy
    ThisWorkbook.Activate
    DNF = ActiveSheet.UsedRange.Rows.Count + 1
    Range("B" & ActiveSheet.UsedRange.Rows.Count + 1).Select
    ActiveSheet.Paste
    Range("A" & DNF & ":A" & ActiveSheet.UsedRange.Rows.Count) = Nomfichier
    Workbooks(Nomfichier).Close savechanges:=False
    Nomfichier = Dir
  Wend
  Columns("A:A").Replace ".xlsx", ""
  Cells.EntireColumn.AutoFit
  Range("A1").Select

End Sub
Le 02/11/2015 à 16:49

J'ai testé mais un message d'erreur 'nom ou numero de fichier incorect s'affiche.

Sub Synthèse()

'Macro permettant de créer une synthèse des succursales

'Effacement de la feuille

Cells.Delete

'Ecriture de la ligne de titre

Range("A1") = "Région"

Range("B1") = "Immeuble"

Range("C1") = "Nombre"

'Mise en forme de la ligne titre

Range("A1:C1").Interior.Color = 13434879

Range("A1:C1").Font.Bold = True

Chemin = ThisWorkbook.Path & "C:\Users\user nm\Desktop\Pojet Ges BD\succursales\"

'Nomfichier = "C:\Users\user nm\Desktop\Pojet Ges BD\succursales\"

Nomfichier = Dir(Chemin & "*.xlsx")

While Len(Nomfichier) > 0

Workbooks.Open Chemin & Nomfichier

AVL = ActiveSheet.UsedRange.Rows.Count - 1

Range("A2:B" & AVL).Copy

ThisWorkbook.Activate

DNF = ActiveSheet.UsedRange.Rows.Count + 1

Range("B" & ActiveSheet.UsedRange.Rows.Count + 1).Select

ActiveSheet.Paste

Range("A" & DNF & ":A" & ActiveSheet.UsedRange.Rows.Count) = Nomfichier

Workbooks(Nomfichier).Close savechanges:=False

Nomfichier = Dir

Wend

Columns("A:A").Replace ".xlsx", ""

Cells.EntireColumn.AutoFit

Range("A1").Select

End Sub

Le 02/11/2015 à 17:15

Bonjour

Il ne faut pas mélanger les 2 chemins

Remplaces cette ligne

Chemin = ThisWorkbook.Path & "C:\Users\user nm\Desktop\Pojet Ges BD\succursales\"

par

Chemin = "C:\Users\user nm\Desktop\Pojet Ges BD\succursales\"
Le 02/11/2015 à 17:54

Il affiche maintenant le message suivant:

Erreur d'exécution 1004: "La méthode 'Range' de l'objet 'Global' a échoué.

Sub Synthèse()

'Macro permettant de créer une synthèse des succursales

'Effacement de la feuille

Cells.Delete

'Ecriture de la ligne de titre

Range("A1") = "Région"

Range("B1") = "Immeuble"

Range("C1") = "Nombre"

'Mise en forme de la ligne titre

Range("A1:C1").Interior.Color = 13434879

Range("A1:C1").Font.Bold = True

Chemin = "C:\Users\user nm\Desktop\Pojet Ges BD\succursales\"

Nomfichier = Dir(Chemin & "*.xlsx")

While Len(Nomfichier) > 0

Workbooks.Open Chemin & Nomfichier

AVL = ActiveSheet.UsedRange.Rows.Count - 1

Range("A2:B" & AVL).Copy

ThisWorkbook.Activate

DNF = ActiveSheet.UsedRange.Rows.Count + 1

Range("B" & ActiveSheet.UsedRange.Rows.Count + 1).Select

ActiveSheet.Paste

Range("A" & DNF & ":A" & ActiveSheet.UsedRange.Rows.Count) = Nomfichier

Workbooks(Nomfichier).Close savechanges:=False

Nomfichier = Dir

Wend

Columns("A:A").Replace ".xlsx", ""

Cells.EntireColumn.AutoFit

Range("A1").Select

End Sub

Le 02/11/2015 à 18:15

Bonjour

Avant de t'envoyer la macro, je l'ai testée avec les fichiers que tu as envoyés et je n'ai pas eu de problème

Il faut savoir la valeur de AVL, Le nom du fichier

Une fois que le programme a planté, fais débogage et place le pointeur de la souris sur AVL (normalement tu dois obtenir sa valeur) fais la même chose sur NomFichier

Fournis dans ton prochain message les renseignements obtenus

On avisera ensuite

Le 03/11/2015 à 10:54

Merci pour votre appui, ça marche maintenant.

Thank you very much!

Le 03/11/2015 à 11:18

Merci infiniment, ça marche super bien, bravo!

J'aimerai maintenant créer un bouton me permettant d'exécuter directement ce module. Comment le faire svp!

Le 03/11/2015 à 11:43

Bonjour

Facile

Dans le ruban onglet Insertion -->Formes --> tu choisis celle qui te plait

Tu inscrits du texte

Clic doit sur la forme et affecter une macro et tu choisis Synthèse

C'est tout

Le 03/11/2015 à 17:49

Bonjour à tous!

J'ai maintenant créer une macro me permettant de faire la synthèse de plusieurs fichier (15) dans une seule feuillle. La syntax fonctionne très bien. Mais y' a une boite de dialogue qui s'affiche à chaque ouverture d'un fichier (voir image joint).

Merci de m'aider à la faire disparaitre.

Voici la syntaxe

Sub Synthèse()

'Macro permettant de créer une synthèse des succursales

'Effacement de la feuille

Cells.Delete

'Ecriture de la ligne de titre

Range("A1") = "Région"

Range("B1") = "Immeuble"

Range("C1") = "Nombre"

'Mise en forme de la ligne titre

Range("A1:C1").Interior.Color = 13434879

Range("A1:C1").Font.Bold = True

Chemin = "C:\Users\user nm\Desktop\Pojet Ges BD\succursales\"

Nomfichier = Dir(Chemin & "*.xlsx")

While Len(Nomfichier) > 0

Workbooks.Open Chemin & Nomfichier

AVL = ActiveSheet.UsedRange.Rows.Count - 1

Range("A2:B" & AVL).Copy

ThisWorkbook.Activate

DNF = ActiveSheet.UsedRange.Rows.Count + 1

Range("B" & ActiveSheet.UsedRange.Rows.Count + 1).Select

ActiveSheet.Paste

Range("A" & DNF & ":A" & ActiveSheet.UsedRange.Rows.Count) = Nomfichier

Workbooks(Nomfichier).Close savechanges:=False

Nomfichier = Dir

Wend

Columns("A:A").Replace ".xlsx", ""

Cells.EntireColumn.AutoFit

Range("A1").Select

End Sub

Le 03/11/2015 à 18:27

Bonjour

Dans un fichier compressé, fourni au moins un fichier qui affiche la boite de dialogue et le dernier fichier de récup

Le 04/11/2015 à 09:44

Bonjour

Voici la boite qui s'affiche dans le fichier joint à chaque ouverture d'un fichier à copier.

Merci

9message.rar (157.62 Ko)
Le 04/11/2015 à 11:46

Bonjour

Rajoutes cette ligne de code

ActiveSheet.Paste
Range("A" & DNF & ":A" & ActiveSheet.UsedRange.Rows.Count) = Nomfichier
Application.CutCopyMode = False
Workbooks(Nomfichier).Close savechanges:=False
Nomfichier = Dir
Wend
Le 04/11/2015 à 12:32

Mer beaucoup, votre appui m'a beaucoup aidé. ça marche super bien.

Bravooos

Rechercher des sujets similaires à "erreur execution 1004"