Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

VBA Word Discussion :

Optimisation temps de traitement


Sujet :

VBA Word

  1. #1
    Futur Membre du Club
    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.

  2. #2
    Futur Membre du Club
    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

  3. #3
    Rédacteur/Modérateur

    Salut,

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


    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 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 :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
    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 :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
    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
    Cycle de vie d'un bon programme :
    1/ ca fonctionne 2/ ca s'optimise 3/ ca se refactorise

    Pas de question technique par MP, je ne réponds pas

    Apprendre à programmer avec Access 2016 et Access 2019

    Pensez à consulter la FAQ Excel et la FAQ Access

    Derniers tutos
    Excel et les paramètres régionaux
    Les fichiers Excel binaires : xlsb,

    Autres tutos

  4. #4
    Futur Membre du Club
    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
    Erreur de compilation
    Référence incorrecte ou non qualifiée

###raw>template_hook.ano_emploi###