Discussion :

[pofito]

Bonjour,

J'ai fait une macro afin de copier des tableaux Excel dans Word en format image.
Ma macro fonctionne bien...une fois sur deux! Avec exactement les mêmes données parfois je tombe sur une erreur 4605 "La méthode PasteSpecial de l'object Selection a échoué". Et ca ne plante jamais sur le même tableau.
Je précise que mes tableaux ont parfois des lignes cachées.

Voici mon code avec un exemple de copie de deux tableaux :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
'Création fichier WORD
Application.DefaultSaveFormat = xlOpenXMLWorkbook
Dim appWrd As Word.Application
Dim docWrd As Word.Document
Set appWrd = New Word.Application
appWrd.Visible = True
appWrd.DefaultSaveFormat = xlOpenXMLWorkbook
Set docWrd = appWrd.Documents.Add
 
'Copie du premier tableau 
Sheets("Rendu").Range("A8:K50").Copy
appWrd.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _
        Placement:=wdInLine, DisplayAsIcon:=False
Application.CutCopyMode = False
 
'Copie du second tableau
Sheets("Rendu").Range("A54:K132").Copy
appWrd.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _
        Placement:=wdInLine, DisplayAsIcon:=False
Application.CutCopyMode = False
 
Set docWrd = Nothing
Set appWrd = Nothing

Merci par avance de votre aide !

[patricktoulon]

Bonjour

adapte le nom du sheet et la plage copiée

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Sub copie_les_deux_tableaux()
 
'Création fichier WORD
Application.DefaultSaveFormat = xlOpenXMLWorkbook
Dim WordApp As Word.Application
 
Dim docWrd As Word.Document
Set WordApp = New Word.Application
WordApp.Visible = True
WordApp.DefaultSaveFormat = xlOpenXMLWorkbook
Set docWrd = WordApp.Documents.Add
 
'Copie du premier tableau
Sheets(1).Range("A1:D6").CopyPicture
WordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _
        Placement:=wdInLine, DisplayAsIcon:=False
'Application.CutCopyMode = False
 
'Copie du second tableau
Sheets(1).Range("A10:D20").CopyPicture
WordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _
        Placement:=wdInLine, DisplayAsIcon:=False
'Application.CutCopyMode = False
 
Set docWrd = Nothing
Set WordApp = Nothing
 
End Sub

attention!!! il faut activer la référence "Microsoft Word xx.x Object Library".

Au plaisir

[pofito]

Merci beaucoup Patrick !

Ca fonctionne très bien même si je ne me l'explique pas trop...
Si aucune instance de Word n'est ouverte la macro fonctionne 10 fois sur 10 lancements par contre si jai déjà des instances de Word d'ouvertes ca plante environ une fois sur 5...
Je pense faire un message d'erreur demander de fermer Word en cas de plantage...ca suffira bien

Encore merci !