Discussion :

[spy20]

Bonjour,
je fais appel à vos conseils car je suis bloqué sur le traitement de mon document.
En résumé et pour simplifier (j'espère) :
- j'ai un document dans lequel j'ai un tableau de valeur
- et un peu plus loin un schéma avec plusieurs objets dont du texte.

L'objectif est selon les valeurs du tableau remplacer ses correspondances dans ce même document, schéma y compris.

Mon problème se situe au niveau du schéma. Le remplace se fait plutôt bien, par contre c'est bien trop lent (~30sec) et l'application Word freeze et affiche ne répond pas. Donc je ne la sollicite pas. Mais pour des utilisateurs ce n'est pas acceptable.

Avez vous des conseils d'optimisation de mon code ou autres ?

Je fais donc une boucle sur mon tableau de valeur et pour chaque valeur je lit le document et je boucle sur le schéma.

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
 For r = 2 To ActiveDocument.Tables(1).Rows.Count
 
            ActiveDocument.Range.Select
            TextOri = ActiveDocument.Tables(1).Cell(r, 1).Range.Text
            TextOri = Left(TextOri, Len(TextOri) - 2)
            'contrôle pour JE = FSI
            If TextOri = "[FSI]" Then
                WX2_JE = ActiveDocument.Tables(1).Cell(r, 2).Range.Text
                WX2_JE = Left(WX2_JE, Len(WX2_JE) - 2)
            End If
            If TextOri = "[WX2_JE]" Then
                ActiveDocument.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 ActiveDocument.Tables(1).Cell(r, 2).Range.Text = "O" Then
                    TextDest = "Z7103"
                End If
                If ActiveDocument.Tables(1).Cell(r, 2).Range.Text = "N" Then
                    TextDest = "Z7100"
                End If
            End If  
 
            'sauvegarde de la variable du tableau car le remplacement agit egalement sur ce tableau de valeurs
            TextOriSave = TextOri
            TextDest = ActiveDocument.Tables(1).Cell(r, 2).Range.Text
            TextDest = Left(TextDest, Len(TextDest) - 2)
 
            ActiveDocument.Range.Select
            Selection.Find.Replacement.ClearFormatting
            'recherche dans tous 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
 
            Application.ScreenUpdating = False
            ActiveDocument.Bookmarks("Schema").Select
            ActiveDocument.Range.Select
 
            For Each LeShape In ActiveDocument.Shapes
                If LeShape.Name Like "Text Box*" Then
                    LeShape.Select
                    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
                End If
            Next
 
            Application.ScreenUpdating = True

Merci par avance

[Invité]

Bonjour,

Pourquoi votre boucle ne s'arrête-t-elle pas ligne 28 du code ?
Si j'ai bien compris, vous cherchez une valeur TextDest qui va remplacer le texte de toutes les formes, ce qui suppose que toutes les conditions précédentes ne peuvent qu'être uniques, alors pourquoi inclure leur mise à jour à chaque ligne du tableau ?

[spy20]

Pardon Eric,
je n'ai pas compris je débute dans le VBA.
Ci-joint un exemple de fichier concerné
https://transfernow.net/023s29n5ktj5

Mon code ne s'arrête pas en ligne 28 du moins je suis toujours dans ma boucle for. Qui fait pour chaque valeur dans le tableau une recherche puis remplacement dans le document et schéma.
Oui TextDest et la valeur remplacé par la recherche de TextOri. Se sera plus compréhensible avec le fichier.
Mais sinon mon tableau :
Nom | Valeur
[IDSI] | E05
Partout où il y a [IDSI] je remplace par E05.

Tu dis : leur mise à jour à chaque ligne du tableau. Je ne comprends pas. Peux-tu m'expliquer avec mon code ?

Merci Eric

[Invité]

Ton code met entre 4 secondes et 7 secondes sur mon pc (Intel I7) en enlevant les debug.print. (Pour visualiser les debug.print : Crtrl-G)

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
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 .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
 
            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
 
 
         Next R
 
  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

Le résultat du Debug.print est le suivant et c'est ce que je voulais indiquer dans mon premier message : Tes textbox prennent toujours la dernière valeur de ton tableau, il est donc inutile de lancer N fois le remplacement.

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
 
Textori :E05, TextDest E05, nom de la forme Text Box 22
Textori :E05, TextDest E05, nom de la forme Text Box 32
Textori :E05, TextDest E05, nom de la forme Text Box 35898
Textori :E05, TextDest E05, nom de la forme Text Box 8
Textori :E05, TextDest E05, nom de la forme Text Box 35909
Textori :E05, TextDest E05, nom de la forme Text Box 35929
Textori :E05, TextDest E05, nom de la forme Text Box 35921
Textori :E05, TextDest E05, nom de la forme Text Box 59
Textori :E05, TextDest E05, nom de la forme Text Box 35937
Textori :E05, TextDest E05, nom de la forme Text Box 35914
Textori :E05, TextDest E05, nom de la forme Text Box 13
Textori :E05, TextDest E05, nom de la forme Text Box 60
Textori :E05, TextDest E05, nom de la forme Text Box 35930
Textori :E05, TextDest E05, nom de la forme Text Box 35884
Textori :E05, TextDest E05, nom de la forme Text Box 35938
Textori :E05, TextDest E05, nom de la forme Text Box 24
Textori :E05, TextDest E05, nom de la forme Text Box 62
Textori :E05, TextDest E05, nom de la forme Text Box 35943
Textori :E05, TextDest E05, nom de la forme Text Box 42
Textori :R, TextDest R, nom de la forme Text Box 22
Textori :R, TextDest R, nom de la forme Text Box 32
Textori :R, TextDest R, nom de la forme Text Box 35898
Textori :R, TextDest R, nom de la forme Text Box 8
Textori :R, TextDest R, nom de la forme Text Box 35909
Textori :R, TextDest R, nom de la forme Text Box 35929
Textori :R, TextDest R, nom de la forme Text Box 35921
Textori :R, TextDest R, nom de la forme Text Box 59
Textori :R, TextDest R, nom de la forme Text Box 35937
Textori :R, TextDest R, nom de la forme Text Box 35914
Textori :R, TextDest R, nom de la forme Text Box 13
Textori :R, TextDest R, nom de la forme Text Box 60
Textori :R, TextDest R, nom de la forme Text Box 35930
Textori :R, TextDest R, nom de la forme Text Box 35884
Textori :R, TextDest R, nom de la forme Text Box 35938
Textori :R, TextDest R, nom de la forme Text Box 24
Textori :R, TextDest R, nom de la forme Text Box 62
Textori :R, TextDest R, nom de la forme Text Box 35943
Textori :R, TextDest R, nom de la forme Text Box 42
Textori :21, TextDest 21, nom de la forme Text Box 22
Textori :21, TextDest 21, nom de la forme Text Box 32
Textori :21, TextDest 21, nom de la forme Text Box 35898
Textori :21, TextDest 21, nom de la forme Text Box 8
Textori :21, TextDest 21, nom de la forme Text Box 35909
Textori :21, TextDest 21, nom de la forme Text Box 35929
Textori :21, TextDest 21, nom de la forme Text Box 35921
Textori :21, TextDest 21, nom de la forme Text Box 59
Textori :21, TextDest 21, nom de la forme Text Box 35937
Textori :21, TextDest 21, nom de la forme Text Box 35914
Textori :21, TextDest 21, nom de la forme Text Box 13
Textori :21, TextDest 21, nom de la forme Text Box 60
Textori :21, TextDest 21, nom de la forme Text Box 35930
Textori :21, TextDest 21, nom de la forme Text Box 35884
Textori :21, TextDest 21, nom de la forme Text Box 35938
Textori :21, TextDest 21, nom de la forme Text Box 24
Textori :21, TextDest 21, nom de la forme Text Box 62
Textori :21, TextDest 21, nom de la forme Text Box 35943
Textori :21, TextDest 21, nom de la forme Text Box 42
Textori :A1, TextDest A1, nom de la forme Text Box 22
Textori :A1, TextDest A1, nom de la forme Text Box 32
Textori :A1, TextDest A1, nom de la forme Text Box 35898
Textori :A1, TextDest A1, nom de la forme Text Box 8
Textori :A1, TextDest A1, nom de la forme Text Box 35909
Textori :A1, TextDest A1, nom de la forme Text Box 35929
Textori :A1, TextDest A1, nom de la forme Text Box 35921
Textori :A1, TextDest A1, nom de la forme Text Box 59
Textori :A1, TextDest A1, nom de la forme Text Box 35937
Textori :A1, TextDest A1, nom de la forme Text Box 35914
Textori :A1, TextDest A1, nom de la forme Text Box 13
Textori :A1, TextDest A1, nom de la forme Text Box 60
Textori :A1, TextDest A1, nom de la forme Text Box 35930
Textori :A1, TextDest A1, nom de la forme Text Box 35884
Textori :A1, TextDest A1, nom de la forme Text Box 35938
Textori :A1, TextDest A1, nom de la forme Text Box 24
Textori :A1, TextDest A1, nom de la forme Text Box 62
Textori :A1, TextDest A1, nom de la forme Text Box 35943
Textori :A1, TextDest A1, nom de la forme Text Box 42
Temps total du traitement : 5 seconde(s)

Pour identifier tes Textbox. Curieusement, je ne retrouve que peu de TextBox lorsque je les colorie en jaune.

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
 
Sub IdentifierLesShapesTextBox()
 
Dim I As Integer
 
    With ActiveDocument
         For I = 1 To .Shapes.Count
             With .Shapes(I)
                  If Mid(.Name, 1, Len("Text Box")) = "Text Box" Then
                  '  .Fill.BackColor.RGB = RGB(255, 255, 0)
                  '  .Fill.BackColor.RGB = RGB(255,255, 255)
                  Debug.Print .Name
 
                  End If
             End With
         Next I
    End With
 
End Sub

[spy20]

Super merci Eric pour ton temps et tes réponses.

Je vais utiliser ton code pour mon fichier final et mesurer exactement le temps que prend le code.
Je dois être globalement à 30sec sur un i5.
Je vais m'appuyer également sur ton code pour l'écriture :-).

Désolé, mais j'arrive toujours pas à bien comprendre ce que tu veux me dire pour mon problème de code à optimiser :-S.
Tu voudrais me dire que je sélectionne directement les textbox par leur nom ?

[Invité]

Si tu fais varier ta boucle de R de = 2 To 2 puis 3 To 3, etc... Ce sont toujours les TextBox ci-dessous qui sont impactés. Et forcément, les valeurs de remplacement sont toujours celles de ta dernière valeur, mais il y a sans doute quelque chose qui m'échappe.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
Text Box 13
Text Box 24
Text Box 62
Text Box 42

Pour visualiser :

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
 
Sub IdentifierLesShapesTextBox()
 
Dim I As Integer
 
    With ActiveDocument
         For I = 1 To .Shapes.Count
             With .Shapes(I)
                  If Mid(.Name, 1, Len("Text Box")) = "Text Box" Then
                     If .Fill.BackColor.RGB = RGB(255, 255, 0) Then
                  '  .Fill.BackColor.RGB = RGB(255,255, 255)
                         Debug.Print .Name
                      End If
                  End If
             End With
         Next I
    End With
 
End Sub

[spy20]

Merci Eric,

je viens d'utiliser ton code pour identifier les shapes. Surtout la partie debug.print finalement et la meilleure écriture du code.
22 sec pour moi le code...et Word qui affiche ne répond pas :@

Pour ma boucle, je ne comprends toujours pas.Désolé pourtant je n'y mets pas de la mauvaise volonté.
Selon moi, le r de ma boucle FOR n'a pas d'incidence sur la boucle des shapes ?

Serait-il mieux dans ce cas, de faire la recherche sur les shapes avec leur nom précis ? Valeur que j'aurais récupéré dans un précédemment.

[Invité]

Ta boucle R fait un balayage sur chaque ligne de ton tableau et à chaque fois tu mets à jour tes shapes, mais c'est toujours la dernière valeur de ton tableau qui est prise en compte (voir le debug.print).

Pour mieux comprendre, j'ai modifié ton code. J'ai mis la mise à jour des shapes après la boucle. Mais sans doute que je n'ai rien compris de ce que fait ton code.

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
79
80
81
82
83
84
85
86
87
88
 
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

[spy20]

Ok je pense mieux comprendre ce que tu évoquais.

Dans mon fichier partagé en début de post.
J'ai un tableau avec plusieurs valeurs : [FSI], [TYPOP]...
Ces valeurs sont à changer dans le texte du document car on retrouve plusieurs fois [FSI]...
Mais dans le schéma aussi il y a plusieurs fois [FSI], [TYPOP]...
C'est pourquoi j'avais gardé la boucle shape dans le For.

Est-ce plus clair ?

[spy20]

Bonjour Eric,

je te remercie pour ton aide;
Je vais fermer ce post et en ouvrir un nouveau avec le fichier plutôt abouti.
Le traitement prend 3min pfiou c'est long ^^.

Cordialement,