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
D'avance merci pour l'aide
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
Partager