VBA - Copier tableau excel dans Word en Image

Version imprimable

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:

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 !

heu.....

Bonjour

adapte le nom du sheet et la plage copiée

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
 
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

03/02/2014, 18h20
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 !