Word [VB Word] 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,

J'espère que ce coup-ci je ne me trompe pas de forum !
Je suis nouveau ici, je ne suis pas informaticien mais j'essaie de ne pas être esclave de l'informatique !
Donc je bricole un peux en VB Word/Excel.

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 ...
J'imagine qu'il y a d'autre manière de faire cette macro (peut être bien plus simple...) mais voici un premier essai !

Si quelqu'un a une idée pour faire ce bricolage ? Même juste une piste ...

Merci d'avance et bonne journé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

 

[fanch55]

Bonsoir,
le code ci-dessous devrait suffire :

Sub Repl()
   Target = InputBox("Entrez l'année recherchée" & vbLf & "et la date remplaçante" & vbLf & "séparées par une virgule")
   If Target <> "" Then
        Target = Split(Target, ",")
        With Selection.Find
            Do
                .Execute "réalisé il y a " & Target(0) & " ans", Forward:=True, Wrap:=wdFindContinue
                If .Found _
                Then .Execute Target(0), replacewith:=Target(1), Replace:=wdReplaceOne
            Loop Until Not .Found
            Selection.Collapse Direction:=wdCollapseEnd
        End With
    End If
End Sub