Bonjour à tous,

Après un dur labeur et grâce à votre aide je suis parvenu a faire une macro qui export mes données excel sous Word, j'ai récemment opté pour un copier coller en tant qu'image :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
.CopyPicture Appearance:=xlScreen, Format:=xlPicture
.paste
Pour remplacer l'ancien :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
.copy
.PasteSpecial Link:=True, DataType:=wdPasteBitmap, _
Placement:=wdInLine, DisplayAsIcon:=False
La macro s'exécute beaucoup plus rapidement, je n'ai plus les bugs liés aux liaisons et c'est bien plus facile de gérer des images.

En revanche la macro semble instable. Parfois elle fonctionne, parfois non. Je dirais que sur 10 exécutions, 6 fonctionnent.
Ça à l'air aléatoire, sans que je ne change rien au fichier (ou que je clique ailleurs)

Quand ça ne fonctionne pas c'est tantôt la ligne du .CopyPicture Appearance:=xlScreen, Format:=xlPicture qui est surlignée et parfois la ligne du .Paste

Si besoin je peux vous laisser un fichier exemple qui reproduit le même phénomène. Le code en question est ci dessous :
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
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
Function exist(feuille As String, nom As String) As Boolean
exist = False
On Error Resume Next
    x = Sheets(feuille).Range(nom).Address
    If Err.Number = 0 Then exist = True
On Error GoTo 0
End Function
 
Sub export_excel_to_word()
    Dim obj As Object
    Dim newObj As Object
    Dim sh As Worksheet
    Dim myFile
Application.ScreenUpdating = False
 
 
    Set obj = CreateObject("Word.Application")
    obj.Visible = True
    Set newObj = obj.Documents.Add
' obj.Selection.ParagraphFormat.LeftIndent = (20)
      With obj.Selection.PageSetup
        .TopMargin = (20)
        .LeftMargin = (17.5)
        .RightMargin = (20)
        .BottomMargin = (0)
        .HeaderDistance = (0)
        .FooterDistance = (15)
    End With
 
For n = 1 To 3
    If exist("En_tête", "page_" & Format(n, "00")) Then
     ThisWorkbook.Worksheets("En_tête").Range("page_" & Format(n, "00")).CopyPicture Appearance:=xlScreen, Format:=xlPicture
        With obj.Selection
        .Paste
       ' .PasteSpecial Link:=True, DataType:=wdPasteBitmap, _
      'Placement:=wdInLine, DisplayAsIcon:=False
     '   .PasteSpecial Link:=True, DataType:=wdPasteEnhancedMetafile, _
      '  Placement:=wdInLine, DisplayAsIcon:=False
        .InsertBreak Type:=6
        End With
     End If
Next
 
For n = 1 To 15
    If exist("Descriptif", "page_" & Format(n, "00")) Then
     ThisWorkbook.Worksheets("Descriptif").Range("page_" & Format(n, "00")).CopyPicture Appearance:=xlScreen, Format:=xlPicture
        With obj.Selection
        .Paste
        .InsertBreak Type:=6
        End With
    End If
Next
 
For n = 1 To 5
    If exist("Carac_tech", "page_" & Format(n, "00")) Then
     ThisWorkbook.Worksheets("Carac_tech").Range("page_" & Format(n, "00")).CopyPicture Appearance:=xlScreen, Format:=xlPicture
        With obj.Selection
        .Paste
        .InsertBreak Type:=6
        End With
    End If
Next
 
newObj.Sections(1).Footers(1).PageNumbers.Add (2)
 
    'obj.Sections(1).Footers(wdHeaderFooterPrimary).PageNumbers.Add _
      ' PageNumberAlignment:=wdAlignPageNumberRight
 
   Application.CutCopyMode = False
    myFile = Replace(ActiveWorkbook.Name, "xlsm", "docx")   'remplacer "docx" par l'extension qui convient, si nécessaire
    newObj.SaveAs Filename:=Application.ActiveWorkbook.Path & "\" & myFile
Application.ScreenUpdating = True
    MsgBox "Export vers Word terminé", vbInformation + vbOKOnly, "Export vers Word"
 
    obj.Activate
    Set obj = Nothing
    Set newObj = Nothing
End Sub

NB : Une personne me propose d'enregistrer temporairement les images copiées pour ensuite les insérer sous word. Sauf que je ne comprend pas comment faire.