Bonjour à toutes et à tous,

Je vous explique rapidement mon problème (qui vous paraîtra peut-être évident...mais je galère ! ^^).
J'ai une macro (que je vous montre en fin de post) qui a pour but de me créer un document Word à partir d'un fichier Excel (en gros, 1 feuille Excel = 1 page Word).
Elle marchait très bien jusqu'à ce que l'informatique me change mon PC (et donc me passe sous Office 2016 - j'étais sous 2010 avant il me semble).
En gros, j'obtiens le message d'erreur Excel "Microsoft Excel attend la fin de l'exécution d'une action OLE d'une autre application", je clique sur "OK" et le message réapparaît indéfiniment.
Je résussis à aller dans le débogeur difficlement, qui me surligne la ligne WrdDoc.Close ou WrdDoc.Quit. Et lorsque je vais dans mon gestionnaire de tâches (Ctrl + Alt + Suppr), je vois bien qu'un enregistrement Word est en cours d'exécution mais il n'arrive pas à le finaliser.
A noter que j'ai bien activé la référence Microsft Word 16.0 Object Library.
Est-ce que ma déclaration d'objets Word est correcte pour une version 2016 ? Une autre piste ? C'est peut-être tout simple, hein...

Un immense merci pour votre aide.

Voici mon code (la partie qui m'intéresse):

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
79
80
81
82
83
84
85
86
87
88
89
90
91
Sub ExportWord()
 
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim ws As Worksheet
 
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim sChemin As String
Dim sCheminFinal As String
sChemin = ThisWorkbook.Path & "\"
sCheminFinal = ThisWorkbook.Path & "\Fiches Générées\"
Dim sNomRapport As String
Dim StartTime As Double
Dim SecondsElapsed As Double
 
StartTime = Timer   'petit bonus : lance un chrono
 
Application.ScreenUpdating = False
 
On Error Resume Next
 
'Export de chaque fiche
For i = 10 To ThisWorkbook.Worksheets.Count
ThisWorkbook.Sheets(i).Select
If ThisWorkbook.Sheets(i).Range("A4").Value <> "                " Then
sNomRapport = ThisWorkbook.Sheets(i).Range("A1") & "_" & ThisWorkbook.Sheets(i).Name
ThisWorkbook.Sheets(i).Range("Intro_" & i).Copy     'copie le tableau d'intro de chaque onglet
 
Set wrdApp = CreateObject("Word.Application")     'ouvre une session Word
wrdApp.Visible = False
Set wrdDoc = wrdApp.Documents.Add    'crée un nouveau document
wrdApp.Selection.PasteAndFormat (wdPasteDefault)
 
ThisWorkbook.Sheets(i).Range("Recap_" & i).Copy     'copie le tableau de chaque onglet
wrdDoc.Paragraphs.Add   'ajoute un paragraphe de type ligne blanche
wrdDoc.Paragraphs(wrdDoc.Paragraphs.Count).Range.PasteAndFormat (wdPasteDefault)  'colle après le paragraphe
 
ThisWorkbook.Sheets(i).Range("Graphs_" & i).CopyPicture     'copie en image les graphiques de chaque onglet
wrdDoc.Paragraphs.Add   'ajoute un paragraphe de type ligne blanche
wrdDoc.Paragraphs(wrdDoc.Paragraphs.Count).Range.PasteAndFormat (wdChartPicture)    'colle en image les graphiques après le paragraphe
 
ThisWorkbook.Sheets(i).Range("NC_" & i).Copy    'copie le tableau des NC
wrdDoc.Paragraphs.Add   'on ajoute un paragraphe
wrdDoc.Paragraphs(wrdDoc.Paragraphs.Count).Range.PasteAndFormat (wdPasteDefault)  'on le colle après le paragraphe
 
ThisWorkbook.Sheets(i).Range("Conclusion_" & i).Copy    'copie l'encadré des commentaires
wrdDoc.Paragraphs.Add   'ajoute un paragraphe (une ligne blanche)
wrdDoc.Paragraphs(wrdDoc.Paragraphs.Count).Range.PasteAndFormat (wdPasteDefault)  'colle après le paragraphe
 
For j = 1 To wrdDoc.Tables.Count
    wrdDoc.Tables(j).AutoFitBehavior wdAutoFitWindow    'ajustement à la page de chaque tableau
Next j
 
For k = 1 To wrdDoc.Paragraphs.Count
    wrdDoc.Paragraphs(k).SpaceAfter = 0     'enlève les espaces après les paragraphes (c'est + esthétique)
Next k
 
For l = 1 To wrdDoc.Tables.Count
    wrdDoc.Tables(l).Rows.Height = 0.3  'mise en forme
Next l
 
wrdDoc.InlineShapes.AddPicture Filename:=ThisWorkbook.Path & "\Fiches Générées\_Logo.png"
 
With wrdDoc.InlineShapes(1)
        .ConvertToShape
End With
 
With wrdDoc.Shapes(1)
      .LockAspectRatio = True
      .WrapFormat.Type = wdWrapBehind
      .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
      .RelativeVerticalPosition = wdRelativeVerticalPositionPage
      .Top = wdShapeTop
      .Left = wdShapeRight
End With
 
Application.CutCopyMode = False
wrdDoc.SaveAs sCheminFinal & sNomRapport    'enregistre la fiche sous son bon nom
 
wrdDoc.Save
wrdDoc.Close
wrdApp.Quit
 
Set wrdDoc = Nothing
Set wrdApp = Nothing
 
End If
Next i