[RESOLU] Erreur d'exécution 4605

Version imprimable

bonjour à tous

voilà j'ai un classeur avec plusieurs feuilles, dans chaque feuille il y a des données que je recopie dans un tableau dans un word-cible pour chaque feuille , mais au bout de 50 fichiers environs crées en moyenne la macro plante avec l 'erreur 4605 , j'arrive pas à voir pourquoi.

si quelqu'un peut m'aider merci

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
Sub CopyRangeToWordBookMark()
 
 ' Déclaration des variables
 Dim AppWord As Word.Application
 Dim DocWord As Word.Document
 Dim oBm As Word.Bookmark
 Dim Folder As String, DocName As String, BookMarkName As String
 Dim rng As Range
 Dim Ws As Worksheet
 Dim feuille_courante As String
 
 
 For Each Ws In ThisWorkbook.Worksheets
 
 ' Affectation des variables
 Set AppWord = New Word.Application
 feuille_courante = ThisWorkbook.ActiveSheet.Name
 Set rng = ThisWorkbook.Worksheets(feuille_courante).Range("A1").CurrentRegion
 Folder = ThisWorkbook.Path
 DocName = "NomdudocumentWord.docx" ' Nom du document Word
 BookMarkName = "Tableau_excel" ' Nom du signet
 
 Application.DisplayAlerts = True
 
 With AppWord
    Set DocWord = AppWord.Documents.Open(Folder & "\" & DocName, ReadOnly:=False)
 End With
 
 Set oBm = DocWord.Bookmarks(BookMarkName)
 rng.Copy ' Copie le tableau Excel
 oBm.Range.PasteExcelTable False, False, False
 
 ' ici code pour sauver le document
 With DocWord
  .SaveAs ThisWorkbook.Path & "\fichieraenvoyer\" & feuille_courante & ".doc", Allowsubstitutions:=True
  End With
 
  AppWord.Application.Quit
  ActiveSheet.Next.Select
 
 Set rng = Nothing: Set AppWord = Nothing: Set DocWord = Nothing: Set oBm = Nothing
 
 Next Ws
 
End Sub

Bonjour,
Pas sûre que cela résolve ton problème, mais il y a qqc que je ne comprends pas dans ta macro : tu fais une boucle sur les feuilles du classeurs avec l'indice ws, mais tu n'utilises jamais ws! Tu fais tout sur la feuille active. Utilise-donc Ws !
D'autre part, tu effectues des operations à l'intérieur de la boucle qui pourraient s'effectuer une fois avant d'entrer dans la boucle plutôt qu'une fois par iteration dans la boucle.
Enfin, regarde comment on utilise le bloc With..End With, car tu n'as pas l'air de savoir l'utiliser correctement.

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
Sub CopyRangeToWordBookMark()
 
 ' Déclaration des variables
 Dim AppWord As Word.Application
 Dim DocWord As Word.Document
 Dim oBm As Word.Bookmark
 Dim Folder As String, DocName As String, BookMarkName As String
 Dim rng As Range
 Dim Ws As Worksheet
 Dim feuille_courante As String
 
'ce qui ne change pas d'une itératio à l'autre dans la boucle :
 Set AppWord = New Word.Application
 Folder = ThisWorkbook.Path
 DocName = "NomdudocumentWord.docx" ' Nom du document Word         '<------ toujours le même nom ???
 BookMarkName = "Tableau_excel" ' Nom du signet 
 
 For Each Ws In ThisWorkbook.Worksheets
     ' Affectation des variables
     feuille_courante = ThisWorkbook.Ws.Name
     Set rng = Ws.Range("A1").CurrentRegion
     Set DocWord = AppWord.Documents.Open(Folder & "\" & DocName, ReadOnly:=False)
     Set oBm = DocWord.Bookmarks(BookMarkName)
     rng.Copy ' Copie le tableau Excel
     oBm.Range.PasteExcelTable False, False, False
      ' ici code pour sauver le document
     DocWord.SaveAs ThisWorkbook.Path & "\fichieraenvoyer\" & feuille_courante & ".doc", Allowsubstitutions:=True
 Next Ws
 
 AppWord.Application.Quit
 Set rng = Nothing: Set AppWord = Nothing: Set DocWord = Nothing: Set oBm = Nothing
End Sub

30/06/2017, 12h48
Izno1978

ok merci, oui j'utilise pas souvent les macros vb je vais voir cela pour mieux l'optimiser.

en tous les cas j'ai relancé et il m'a fait mes 1000 doc d'un coup cette fois ci sans soucis.