Bonjour,

J'ai une macro qui ouvre un fichier word, copie son contenu et le colle dans une feuil sur mon fichier excel.
Après avoir collé mon fichier, je souhaite fermer mon fichier word. Le problème c'est que ça prend très longtemps (+ ou - 10 secondes) en testant en faisant pas à pas chaque ligne de mon code.
Avez vous une idée de pourquoi ?
La ligne en question (ligne 43):
Code : Sélectionner tout - Visualiser dans une fenêtre à part
WordApp.Quit

Le code de mon fichier :
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
Sub general()
 
    Dim shA As Worksheet
    Dim wB As Workbook
    Set shA = Sheets("x")
    Set wB = Workbooks.Open(Filename:="blabla.xlsx")
    Dim lastline, lastline2, number, index, diff, produit, nbproduit, index2, boucle As Integer
    Dim test As String
 
 
    'Update les produits du fichier de shipping UPS
    lastline = shA.UsedRange.Rows.Count
    lastline2 = wB.Sheets(1).UsedRange.Rows.Count
    index = lastline2
    number = shA.Cells(lastline, 2)
    While wB.Sheets(1).Cells(index, 2) <> number
        index = index - 1
    Wend
    wB.Sheets(1).Range("B" & index + 1 & ":F" & lastline2).Copy Destination:=shA.Range("B" & lastline + 1)
    wB.Close False
    Set wB = Nothing
 
    'On va chercher les produits dans les factures
    diff = lastline2 - index
    boucle = 1
    Dim WordDoc As Word.Document
    Dim WordApp As Word.Application
 
    While boucle <> diff
        produit = shA.Cells(lastline + 1, 2)
        Set WordApp = New Word.Application
        WordApp.Visible = False
        Set WordDoc = WordApp.Documents.Open("blabla.docx", ReadOnly:=True)
        With WordApp
            .Selection.WholeStory
            .Selection.Copy
        End With
 
        Sheets.Add.Name = "tmp"
        Set shA2 = Sheets("tmp")
        shA2.Range("A1").Select
        shA2.Paste
        WordApp.Quit
        Application.CutCopyMode = False
 
 
        nbproduit = 1
        index2 = 21
        shA.Cells(lastline + 1, 9) = shA2.Cells(20, 1)
        shA.Cells(lastline + 1, 10) = shA2.Cells(20, 2)
        lastline = lastline + 1
        While shA2.Cells(index2, 1) <> ""
            shA.Cells(lastline + 1, 1).EntireRow.Insert Shift:=xlDown
            shA.Cells(lastline + 1, 2) = shA.Cells(lastline + 1 - nbproduit, 2)
            shA.Cells(lastline + 1, 2).Interior.Pattern = xlNone
            shA.Cells(lastline + 1, 3) = shA.Cells(lastline + 1 - nbproduit, 3)
            shA.Cells(lastline + 1, 3).Interior.Pattern = xlNone
            shA.Cells(lastline + 1, 4) = shA.Cells(lastline + 1 - nbproduit, 4)
            shA.Cells(lastline + 1, 4).Interior.Pattern = xlNone
            shA.Cells(lastline + 1, 5).Interior.Pattern = xlNone
            shA.Cells(lastline + 1, 9) = shA2.Cells(index2, 1)
            shA.Cells(lastline + 1, 10) = shA2.Cells(index2, 2)
            lastline = lastline + 1
            index2 = index2 + 1
            nbproduit = nbproduit + 1
        Wend
 
    Set WordDoc = Nothing
    Set WordApp = Nothing
    Application.DisplayAlerts = False
    Sheets("tmp").Delete
    Set shA2 = Nothing
    boucle = boucle + 1
    Wend
 
    Set shA = Nothing
 
End Sub
Merci d'avance !

Marty