Optimisation temps de traitement

Bonjour,

j'ouvre ce nouveau sujet suite à l'aide précieuse d'Eric https://www.developpez.net/forums/d2...e-freeze-word/.

Mon fichier https://transfernow.net/95a46362x0fa

Dans ce fichier, je fais appel à une macro principale qui va à partir d'un tableau de valeur (variable | résultat), remplacer -dans une copie synthétique de ce même fichier WORD- toutes les variables selon les résultats du tableau dans le texte (corps document et schéma).

Je fais donc une boucle sur toutes mes valeurs du tableau pour remplacer dans le fichier et pour toutes les formes du schéma qui sont des Text Box.

Mon soucis se situe au niveau du temps de traitement. Sur un i5 je suis à 3min.
Le temps de traitement le plus long est au niveau de la boucle sur les formes (LeShape).
Cette lourdeur indique que Word ne répond pas dans sa barre de titre.

Je débute sur VBA et je ne sais pas comment optimiser mon code pour qu'il soit fluide.

Merci beaucoup par avance pour vos conseils.

Bonjour,

je relance ce sujet sans réponse.
Je suis toujours bloqué avec mon fichier qui n'a pas un temps de traitement satisfaisant à cause de la boucle sur les formes Word.

Merci par avance si vous avez des conseils.
Cordialement

Salut,

je reintroduis le code dont il est question directement ici, pour ne pas faire faire des allers-retours inutilement :

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
Sub Test()
 
Dim R As Long
Dim TextOri As String, WX2_JE As String, TextDest As String, TextOriSave As String
Dim LeShape As Shape
Dim HeureDebut, HeureFin, TempsTotal
 
 
    HeureDebut = Timer    ' Définit l'heure de début.
 
    Application.ScreenUpdating = False
 
    With ActiveDocument
         For R = 2 To ActiveDocument.Tables(1).Rows.Count
 
            .Range.Select
            TextOri = .Tables(1).Cell(R, 1).Range.Text
            TextOri = Left(TextOri, Len(TextOri) - 2)
            'contrôle pour JE = FSI
            If TextOri = "[FSI]" Then
                WX2_JE = .Tables(1).Cell(R, 2).Range.Text
                WX2_JE = Left(WX2_JE, Len(WX2_JE) - 2)
            End If
            If TextOri = "[WX2_JE]" Then
                .Tables(1).Cell(R, 2).Range.Text = WX2_JE
            End If
            'contrôle pour indiquer quelle chaine Z71 utiliser si HA
            If TextOri = "(RDS_SAJ_HA)" Then
                If .Tables(1).Cell(R, 2).Range.Text = "O" Then TextDest = "Z7103"
                If .Tables(1).Cell(R, 2).Range.Text = "N" Then TextDest = "Z7100"
            End If
 
            'sauvegarde de la variable du tableau car le remplacement agit egalement sur ce tableau de valeurs
            TextOriSave = TextOri
            TextDest = .Tables(1).Cell(R, 2).Range.Text
            TextDest = Left(TextDest, Len(TextDest) - 2)
 
           ' Debug.Print TextDest
 
            .Range.Select
            Selection.Find.Replacement.ClearFormatting
            'recherche dans tout le document pour faire un remplacement
            With Selection.Find
                .ClearFormatting
                .Text = TextOri
                .Replacement.ClearFormatting
                .Replacement.Text = TextDest
                .Forward = True                 'recherche depuis le debut du document
                .Wrap = wdFindStop              'la recherche s'arrete à la fin du document (pas de reprise au début)
                .Execute Replace:=wdReplaceAll
            End With
 
         '   .Bookmarks("Schema").Select
         '   .Range.Select
 
         Next R
 
         For Each LeShape In .Shapes
                If LeShape.Name Like "Text Box*" Then
                    LeShape.Select
                    Selection.ShapeRange.Fill.BackColor.RGB = RGB(255, 255, 255)
                    Debug.Print "Textori :" & TextOri & ", TextDest " & TextDest & ", nom de la forme " & LeShape.Name
                    With Selection.Find
                        .ClearFormatting
                        .Text = TextOri
                        .Replacement.ClearFormatting
                        .Replacement.Text = TextDest
                        .Forward = True                 'recherche depuis le debut du document
                        .Wrap = wdFindStop              'la recherche s'arrete à la fin du document (pas de reprise au début)
                        .Execute Replace:=wdReplaceAll
                    End With
                    Selection.ShapeRange.Fill.BackColor.RGB = RGB(255, 255, 0)
                End If
            Next
 
 
 
  End With
 
  Application.ScreenUpdating = True
 
 
  HeureFin = Timer    ' Définit l'heure de fin.
  TempsTotal = HeureFin - HeureDebut    ' Calcule la durée totale.
  Debug.Print "Temps total du traitement : " & Round(TempsTotal, 0) & " seconde(s)"
 
End Sub

A quoi te sert de faire
TextOriSave = TextOri
vu que tu n'utilises pas la variable par après ?

Passer par l'objet Selection c'est pas mal moyen je crois me rappeler :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
For Each LeShape In .Shapes
                If LeShape.Name Like "Text Box*" Then
                    LeShape.Select
                    Selection.ShapeRange.Fill.BackColor.RGB = RGB(255, 255, 255)
                    Debug.Print "Textori :" & TextOri & ", TextDest " & TextDest & ", nom de la forme " & LeShape.Name
                    With Selection.Find
                        .ClearFormatting
                        .Text = TextOri
                        .Replacement.ClearFormatting
                        .Replacement.Text = TextDest
                        .Forward = True                 'recherche depuis le debut du document
                        .Wrap = wdFindStop              'la recherche s'arrete à la fin du document (pas de reprise au début)
                        .Execute Replace:=wdReplaceAll
                    End With
                    Selection.ShapeRange.Fill.BackColor.RGB = RGB(255, 255, 0)
                End If
            Next

à transformer probablement en

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
For Each LeShape In .Shapes
                If LeShape.Name Like "Text Box*" Then
                    With LeShape
                    ShapeRange.Fill.BackColor.RGB = RGB(255, 255, 255)
                    Debug.Print "Textori :" & TextOri & ", TextDest " & TextDest & ", nom de la forme " & LeShape.Name
                    With .Find
                        .ClearFormatting
                        .Text = TextOri
                        .Replacement.ClearFormatting
                        .Replacement.Text = TextDest
                        .Forward = True                 'recherche depuis le debut du document
                        .Wrap = wdFindStop              'la recherche s'arrete à la fin du document (pas de reprise au début)
                        .Execute Replace:=wdReplaceAll
                    End With
                    .ShapeRange.Fill.BackColor.RGB = RGB(255, 255, 0)
                    End With
                End If
            Next

Merci beaucoup pour ton retour Jean-Philippe.

La variable TextOriSave est utilisée à la fin de la boucle principale pour remettre les valeurs initiales.
Le remplacement agit sur tout le document donc je conserve mes variables.
Je prends note également de tes déclarations de variables

Ok je vais tester ton idée de code pour ne pas utiliser l'objet Selection
Edit : j'ai une erreur sur le With .Find

Citation:

Erreur de compilation
Référence incorrecte ou non qualifiée