Bonjour

Je développe actuellement une application simple qui doit à partir d'Excel ouvrir un fichier Word qui contient des signets et copier en mode image des parties de tableaux Excel. Le code est dessous.

Je rencontre un double problème :

1. L'application est très lente et m'envoie le message suivant au bout de plusieurs minutes alors qu'en mode débuggage elle fonctionne bien. Lorsque cela ne marche pas, l'application semble bloquer au niveau de ".Show". Après quelques reboot, il arrive qu'elle finisse par fonctionner plusieurs fois de suite.

"Microsoft Excel attend la fin de l'exécution d'une action OLE d'une autre application"

2. Sur les 4 tableaux à copier, le 1er se passe bien et les 3 autres se copient en début de page mais pas dans les signets. Pour info le document Word est tout simple (4 pages avec dans chacune d'elle un signet. Donc 4 signets dans le doc Word

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
Sub export_données_dans_signet_word()
 
' Penser à activer dans "Outils" "Références" Microsoft Word 14.0 Object Library
 
Dim AppWord As New Word.Application
 
Dim dlg As FileDialog
Dim MonFichierWord As String
Dim i As Integer
Dim Chemin As String
 
Chemin = ThisWorkbook.Worksheets("Sommaire").Range("J22")
 
Set dlg = AppWord.FileDialog(msoFileDialogFilePicker)
 
    With dlg
        .InitialFileName = Chemin
        .AllowMultiSelect = False
        .Title = "Choix de la proposition modèle"
        .Show
    End With
 
MonFichierWord = dlg.SelectedItems(1)
AppWord.Documents.Open MonFichierWord
 
AppWord.Visible = True    'Word est visible pendant l'opération
 
' Collage dans Word
 
   For i = 1 To 4
 
       Select Case i
 
 
       Case 1
 
             ThisWorkbook.Worksheets("Proposition_Périmètre").Range("B7:D15").Copy
             AppWord.ActiveDocument.Bookmarks("Périmètre_F01").Range.PasteSpecial , DataType:=wdPasteMetafilePicture
             Application.CutCopyMode = False
 
       Case 2
 
             ThisWorkbook.Worksheets("Proposition_Périmètre").Range("B16:D22").Copy
             AppWord.ActiveDocument.Bookmarks("Périmètre_F02").Range.PasteSpecial , DataType:=wdPasteMetafilePicture
             Application.CutCopyMode = False
 
        Case 3
 
             ThisWorkbook.Worksheets("Proposition_Périmètre").Range("B23:D27").Copy
             AppWord.ActiveDocument.Bookmarks("Périmètre_F03").Range.PasteSpecial , DataType:=wdPasteMetafilePicture
             Application.CutCopyMode = False
 
        Case 4
 
            ThisWorkbook.Worksheets("Licences").Range("B4:H12").Copy
            AppWord.ActiveDocument.Bookmarks("Périmètre_F04").Range.PasteSpecial , DataType:=wdPasteMetafilePicture
            Application.CutCopyMode = False
 
        End Select
 
    Next i
 
ThisWorkbook.Worksheets("Sommaire").Range("J22") = MonFichierWord
 
MsgBox ("Opération terminée. Basculez sous Word pour voir les modifications avant sauvegarde")
 
'fermer le document Word avec sauvegarde
'AppWord.ActiveDocument.Save
'AppWord.Quit
 
'Libérer la mémoire des objets
Set dlg = Nothing
Set AppWord = Nothing
 
End Sub
D'avance merci pour l'aide