Extraction de tableaux Excel dans Word: problème de vitesse d'exécution

Version imprimable

11/08/2015, 15h04
mikoto96

Extraction de tableaux Excel dans Word: problème de vitesse d'exécution

Bonjour,

Je travaille actuellement sur une feuille de calcul pour mon boulot. Ma feuille correspond à une succession d'étape de calculs d'une structure qui est divisée en différents "niveaux". Du coup, pour chaque étape de calculs, j'ai un tableau qui récapitule mes résultats par niveau. Ca me fait donc beaucoup de tableaux à "sortir" d'excel pour les recoller dans ma note de résultat word (une 10zaine de pages environ).
J'ai donc voulu automatiser un peu tout ça. Dans une macro sous mon fichier excel, j'ouvre un word qui extrait mes tableaux un par un en les copiant-collant du excel au word avec des titres qui vont bien et tout et tout.
Seul problème, et pas des moindres: quand j'exécute la marco d'un seul coup, j'ai des tableaux qui ressortent partiellement... Quand je fait du pas à pas avec des points bloquant, aucun soucis. Du coup, j'ai tenté de placer des tempos (type Application.Wait Now + TimeValue("00:00:01")) entre chaque "copiage" de tableau. Mais j'ai toujours le problème.

Si quelqu'un a une idée? j'avoue que je ne vois pas comment me sortir de là!

Merci par avance.

Mikoto
11/08/2015, 16h01
Kimy_Ire

Bonjour mikoto96,

La plupart du temps, quand tu as des différences entre le mode pas à pas et le mode "normal" ceci est dû à des With manquants, des Select (à proscrire) mal effectués ou un quelconque focus mal positionné.

Je te propose que tu nous envoies ton code afin que la communauté puisse d'avantage t'aider. :ccool:
Malheureusement, sans plus d'explications, tu concevras aisément qu'il est difficile d'apporter une solution.

Cordialement,
Kimy

Je veux bien coller un exemple du code. J'espère que ce sera assez clair. Il y a des variables qui sont cherchés automatiquement pour trouver le début et la fin des tableau ainsi que la gauche et la droite des tableaux (et certains tableaux sont copiés en deux morceaux car trop long pour rentrer sur une page word, donc répétition des colonnes). Qui plus est, je recolle chaque tableau en bas de mon fichier excel avant de le coller dans word. Je suis obligée de faire cette manipe, sinon j'ai des sortes de signets qui s'ajoutent à mon word et tous les tableaux ajoutés se retrouvent dans mon sommaire automatique word (j'ai pas compris pourquoi, je ne trouve pas comment supprimer les style de titres qui n'en sont même pas, donc j'ai triché de cette manière). Ca fait bricolo, mais ça fonctionne.

Le principe du code:

Code:

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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
 
'------------------------------------------------------------------------------------------------
'---RESISTANCE DU SILO---
'------------------------------------------------------------------------------------------------
 
        With WordApp.Selection
        .Paragraphs(1).Range.Style = "Titre " & Titre
        .TypeText Text:="Contraintes de résistance au voilement à l’état ultime du silo"
        .TypeParagraph
 '------------------------------------------------------------------------------------------------
       '---Parois verticales du silo---
        .Paragraphs(1).Range.Style = "Titre " & Titre + 1
        .TypeText Text:="Parois verticales du silo"
        .TypeParagraph
        End With
        NbP = WordDoc.Paragraphs.Count
 
        j = k
        i = j
 
        Do While i <= DernLigne
            If Cells(i, 1) = "R2" Then
                k = i
                i = DernLigne
            End If
            i = i + 1
        Loop
 
        i = 2
 
        Do While i <= 100
            If Cells(j, i) = "G" Then
                Gau = i
            Else
                If Cells(j, i) = "D" Then
                    Dro = i
                    i = 100
                End If
            End If
            i = i + 1
        Loop
 
 
        i = j
 
        Do While i < k
            If Cells(i, 2) = "D" Then Deb = i
            If Cells(i, 2) = "F" Then
                Fin = i
                ActiveSheet.Range(Cells(Deb, Gau), Cells(Fin, Dro)).Copy
                WordApp.ActiveDocument.Paragraphs(NbP).Range.Paste
                WordApp.Selection.EndKey Unit:=wdStory
                WordApp.Selection.TypeText Text:=""
                WordApp.Selection.TypeParagraph
                NbP = WordDoc.Paragraphs.Count
                i = k
            End If
            i = i + 1
        Loop
 
 '----***********************************************************************************---
                       '---Compression méridienne, circonférentielle & cisaillement---
 
            j = k
            i = j
 
            Do While i <= DernLigne
                If Cells(i, 1) = "R3" Then
                    k = i
                    i = DernLigne
                End If
                i = i + 1
            Loop
 
 
            For o = 1 To 3
 
            With WordApp.Selection
            .Paragraphs(1).Range.Style = "Titre " & Titre + 2
            If o = 1 Then .TypeText Text:="Compression méridienne"
            If o = 2 Then .TypeText Text:="Compression circonférentielle"
            If o = 3 Then .TypeText Text:="Cisaillement"
            .TypeParagraph
            End With
            NbP = WordDoc.Paragraphs.Count
 
 
 
                i = 2
 
                Do While i <= 100
                    If Cells(j, i) = "G" & o Then
                        Gau = i
                    Else
                        If Cells(j, i) = "D" & o Then
                            Dro = i
                            i = 100
                        End If
                    End If
                    If Cells(j, i) = "VirCol" Then VirRef = i
                    i = i + 1
                Loop
 
 
                i = j
 
 
                Do While i < k
 
                    If Cells(i, 2) = "D" Then Deb = i
 
                    If Cells(i, 2) = "F" Then
 
                        Fin = i
                        ActiveSheet.Range(Cells(Deb, Gau), Cells(Fin, Gau + 3)).Copy
                        Cells(DernLigne + 2, VirRef).Select
                        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                        Range(Cells(DernLigne + 2, VirRef), Cells(DernLigne + 2 + Fin - Deb, VirRef + 3)).Copy
                        WordApp.ActiveDocument.Paragraphs(NbP).Range.Paste
                        WordApp.Selection.EndKey Unit:=wdStory
                        WordApp.Selection.TypeText Text:=""
                        WordApp.Selection.TypeParagraph
                        NbP = WordDoc.Paragraphs.Count
                        Range(Cells(DernLigne + 2, VirRef), Cells(DernLigne + 2 + Fin - Deb, VirRef + 3)).Clear
 
                    End If
 
 
                    If Cells(i, 2) = 0 And IsEmpty(Cells(i, 2)) = False Then
 
                        Fin = i
 
                        NbVir = NbViroleS
 
                        'Premières colonnes du tableau (répétitives)
                        Range(Cells(Deb, VirRef), Cells(Deb + 2, VirRef + 1)).Copy
                        Cells(DernLigne + 2, VirRef).Select
                        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                        Range(Cells(Fin - (NbVir), VirRef), Cells(Fin, VirRef + 1)).Copy
                        Cells(DernLigne + 2 + 3, VirRef).Select
                        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
                        Application.Wait Now + TimeValue("00:00:01")
 
                        'Colonnes de données part.1
                        Range(Cells(Deb, Gau), Cells(Deb + 2, Gau + 7)).Copy
                        Cells(DernLigne + 2, VirRef + 2).Select
                        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                        Range(Cells(Fin - (NbVir), Gau), Cells(Fin, Gau + 7)).Copy
                        Cells(DernLigne + 2 + 3, VirRef + 2).Select
                        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
                        Range(Cells(DernLigne + 2, VirRef), Cells((DernLigne + 2 + 3) + (NbVir), VirRef + 2 + 7)).Copy
                        Application.Wait Now + TimeValue("00:00:01")
                        WordApp.ActiveDocument.Paragraphs(NbP).Range.Paste
                        WordApp.Selection.EndKey Unit:=wdStory
                        WordApp.Selection.TypeText Text:=""
                        WordApp.Selection.TypeParagraph
                        NbP = WordDoc.Paragraphs.Count
 
                        Range(Cells(DernLigne + 2, VirRef + 2), Cells((DernLigne + 2 + 3) + (NbVir), VirRef + 2 + 7)).Clear
 
                        Application.Wait Now + TimeValue("00:00:01")
                        'Colonnes de données part.2
                        Range(Cells(Deb, Gau + 8), Cells(Deb + 2, Dro)).Copy
                        Cells(DernLigne + 2, VirRef + 2).Select
                        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                        Range(Cells(Fin - (NbVir), Gau + 8), Cells(Fin, Dro)).Copy
                        Cells(DernLigne + 2 + 3, VirRef + 2).Select
                        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
                        Range(Cells(DernLigne + 2, VirRef), Cells((DernLigne + 2 + 3) + (NbVir), VirRef + 2 + (Dro - Gau - 7))).Copy
                        Application.Wait Now + TimeValue("00:00:01")
                        WordApp.ActiveDocument.Paragraphs(NbP).Range.Paste
                        WordApp.Selection.EndKey Unit:=wdStory
                        WordApp.Selection.TypeText Text:=""
                        WordApp.Selection.TypeParagraph
                        NbP = WordDoc.Paragraphs.Count
 
                        Range(Cells(DernLigne + 2, VirRef), Cells((DernLigne + 2 + 3) + (NbVir), VirRef + 2 + (Dro - Gau - 7))).Clear
 
                        i = k
 
                    End If
 
                    i = i + 1
 
                Loop
 
            Next o

J'avoue que c'est aussi la première fois que je passe d'excel à word. Donc il est fort probable qu'il y a plus simple ou du moins plus correct.

Pour info, le début du code avec création du word:
'---CREATION DU WORD---

Code:

1
2
3
4
5
6
7
8
 
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
 
    Set WordApp = CreateObject("Word.Application")    'ouvre une session Word
    Set WordDoc = WordApp.Documents.Add    'créé un nouveau document word
'    Set WordDoc = WordApp.Documents.Open("C:\Users\girard\Desktop\Doc1.docx", ReadOnly:=True)    'ouvre le document Word
    WordApp.Visible = False    'Word est masqué pendant l'opération

En ce qui concerne les pistes énoncées: il est fort probable que ça vienne d'un "Select" plutôt que d'un "With". Mais je ne fais de programmation qu'en guise d' "amélioration de productivité" pour ma petite boite. C'est loin d'être mon boulot principal. Donc, je m'avance peut-être.

Merci en tout cas de vous intéresser à mon problème!

Mikoto

11/08/2015, 17h32
kiki29

Salut, à titre d'info ( sera-ce utile ? ) l'inverse : pilotage de Word depuis Excel

Bonjour mikoto96,

Bon... par où commencer ?
Je pense que ton problème vient du fait que tu ne cibles aucun classeur ni aucune feuille dans ta macro.
En effet, lorsque tu passes d'une feuille à une autre, d'une application à une autre, il est préférable de préciser, à chaque fois, de quelle application/classeur/feuille on parle.

Un exemple simple :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Option Explicit Sub test() With Workbooks("Classeur1") ' le point "." permet de dire que l'on cherche l'élément dans le "With" donc, ici, la feuille "Feuil1" de "Classeur1" With .Worksheets("Feuil1") ' de la même manière, le point "." permet de définir l'élément dans le "With" donc, ici, la cellule A1 de la "Feuil1" (du "Classeur1") MsgBox .Range("A1") End With End With End Sub
Ceci est important pour diverses raisons.
Par exemple :
Code:

1 2 3 4 5 6 7 8 9 Sub test2() 'Va te retourner la valeur contenue dans la cellule A1 de la feuille active MsgBox Range("A1") 'Va te retourner la valeur contenue dans la celulle A1 de la Feuil1 (tout le temps) MsgBox Worksheets("Feuil1").Range("A1") End Sub
Même si tu n'as qu'une seule feuille dans ton classeur, le fait que tu changes d'application et que tu ailles sur Word peut engendrer la perte de données que tu constates.

Ensuite, il y a un travail évident de gestion des variables à revoir. Tu passes des valeurs d'une variable à une autre de manière répétitive... on ne comprend plus ce que tu fais.
Ainsi, il semblerait nécessaire que tu commentes ton code. Si tu reviens dessus dans 1 semaine, je suis sûr que tu vas perdre 20 minutes à comprendre certaines lignes.

Enfin, tu as une procédure répétitive que l'on pourrait extraire et qui diminuerait par... *le nombre de tableaux que tu colles* ... donc par 10 le nombre de lignes de code.

Ainsi, je te propose que tu m'envoies un fichier dans lequel tu aurais supprimé les données confidentielles afin que je puisse (ainsi que la communauté) apprécier d'avantage les améliorations à apporter et trouver la cause de tes difficultés.

Au passage, tu peux supprimer tes "Tempo". Elles ne servent à rien. ;)

Cordialement,
Kimy

1 pièce(s) jointe(s)

Bonjour,

Je joins le fichier excel un peu épuré: Pièce jointe 185214

Concernant le code, je l'ai fait au plus vite. Donc, il est assez répétitif. Habituellement, j'essaye quand même de faire des "Function" pour éviter ces répétitions.
Pour les "with":
Code:

1 2 3 4 5 6 7 8 With Workbooks("Classeur1") ' le point "." permet de dire que l'on cherche l'élément dans le "With" donc, ici, la feuille "Feuil1" de "Classeur1" With .Worksheets("Feuil1") ' de la même manière, le point "." permet de définir l'élément dans le "With" donc, ici, la cellule A1 de la "Feuil1" (du "Classeur1") MsgBox .Range("A1") End With End With
...effectivement, je ne les utilise jamais. Si je comprend bien, c'est une "faute grave". J'ai un peu appris à coder sur le tas, donc il y a quelques bases qui me manques. Cela ne m'avait peut être pas fait défaut jusqu'à maintenant car j'ai pour habitude de travailler toujours dans le même workbook et je sélectionne la feuille de travail dont j'ai besoin.

En ce qui concerne la feuille de calcul, quelques explications:

Le code d'extraction est lié au bouton "extraction NCS" (Sub Import du module MImportResult) en haut à gauche.
L'extraction se fait par étape: Les lignes surlignées en magenta sont mes limites pour chaque étape d'extraction. La Colonne bleue marque le début et la fin de mes tableaux (ce sont les référence que j'utilise dans le code: Gau, Dro, Deb, Fin).

Voilà.
Merci d'avance pour le temps consacré.

Mikoto

Bonjour mikoto96,

Juste un exemple avec la fonction Init :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Sub Init() Dim oRng As Range Dim oOff As Integer With Feuil2 'Recherche VIR en colonne 1 Set oRng = .Columns(1).Find("VIR", LookIn:=xlValues, LookAt:=xlWhole) 'Détermine la colonne dans laquelle on trouve VIRCOL par rapport à VIR oOff = .Rows(oRng.Row).Find("VIRCOL", LookIn:=xlValues, LookAt:=xlWhole).Column 'On détermine les valeurs NbViroleS et NbViroleT grâce aux éléments trouvés précédemment NbViroleS = .Cells(Range(oRng, .Cells(Rows.Count, 1).End(xlUp)).Find("Silo", LookIn:=xlValues, LookAt:=xlWhole).Row, oOff) NbViroleT = .Cells(Range(oRng, .Cells(Rows.Count, 1).End(xlUp)).Find("Tremie", LookIn:=xlValues, LookAt:=xlWhole).Row, oOff) 'MsgBox NbViroleS & " " & NbViroleT End With End Sub
Petits points cependant :

Ceci : Dim i, j, k, m, n, o As Integer a pour effet de déclarer la variable "o" en tant que Integer. Toutes les variables précédentes sont déclarées en tant que Variant ce qui prend plus de mémoire, pour rien.
Tu dois écrire ceci : Dim i As Integer, j As Integer, k As Integer, m As Integer, n As Integer, o As Integer.
J'ai vraiment beaucoup de mal à comprendre tes Do ... While dans tous les sens. Connais-tu la boucle For, la méthode Find ?
Les points suivants... on verra ça plus tard. ;)

Bref, je tente de continuer sur le suite.

Cordialement,
Kimy