XL 2016 Macro Word pour remplacer une chaîne dans une chaîne recherchée sans changer la mise en forme

[Axelair]

Bonsoir à tous et merci d'avance pour vos conseils,

Je cherche à modifier du texte dans un fichier word sans modifier la mise en forme.
L'objectif est de modifier par exemple : "Projet1 réalisé il y à 8 ans" -> "Projet1 réalisé il y à 9 ans" .
Ce n'est pas indiqué Projet1, Projet2, Projet3 dans le word mais des noms de projets spécifiques.

...
blablabla réalisé il y a 15 ans
...
bla réalisé il y a 5 ans
...
blablablabla réalisé il y a 2 ans
...
blablabla réalisé il y a 3 ans
...
blabla réalisé il y a 6 ans
...

J'ai 2 problèmes :

• ce n'est pas toujours indiqué "8 ans", alors je cherche à modifier la valeur en gras peut importe sa valeur, peut être en utilisant :

  "Projet1 réalisé il y à " & * & "ans"

• le texte est mis en forme et la mise en forme n'est pas la même pour tous les mots (gras, couleur, ...)

J'ai réalisé (ci-après) un code un peu laborieux qui marche si la valeur est 8, mais il faudrait que je fasse cela de nombreuse fois pour toutes les autres valeurs possibles et tous les autres projets ...
Si quelqu'un a une idée pour faire ce bricolage ? Même juste une piste ...

Merci d'avance et bonne soirée à tous !

Sub remplacer2()

Application.ScreenUpdating = False
Selection.HomeKey Unit:=wdStory

    Do
        With Selection.Find
            '.ClearFormatting
            .Text = "Projet1 réalisé il y à 8 ans"
            .Forward = True
            .Wrap = wdFindStop
            .Execute
        End With

    If Selection.Find.Found Then

        With Selection.Find
            '.ClearFormatting
            .Text = "8 ans"
            .Replacement.Text = "9 ans"
            .Forward = True
            .Wrap = wdFindAsk
            .Format = False
            '.Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Execute
        
            With Selection
                If .Find.Forward = True Then
                    .Collapse Direction:=wdCollapseStart
                Else
                    .Collapse Direction:=wdCollapseEnd
                End If
                .Find.Execute Replace:=wdReplaceOne
                If .Find.Forward = True Then
                    .Collapse Direction:=wdCollapseEnd
                Else
                    .Collapse Direction:=wdCollapseStart
                End If
                .Find.Execute
            End With
        
        End With
    
    End If
    Loop Until Not Selection.Find.Found
    
Application.ScreenUpdating = True
End Sub

 

[Hasco]

Bonjour,

Vous n'êtes pas dans le bon forum., le bon forum :

https://www.excel-downloads.com/forums/autres-applications.22/

cordialement

 

[Axelair]

Merci et désolé ... Erreur du débutant !
Je n'arrive pas à supprimer ce message dans le doute j'ai indiqué votre réponse comme la solution !
Merci encore et bonne journée.