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
Partager