Discussion :

[Toms560]

Bonjour,

J'ai un fichier Excel qui contient une macro permettant de générer un fichier Word pré-rempli avec des "variables" qui seront remplacés par des paramètres rentrés dans mon fichier Excel.
Jusqu'ici tout va bien. Je dois ensuite rayer tel ou tel mot selon le paramétrage dans Excel.

Pour cela, j'ai trouvé une macro sur le net qui pourrait faire le taf, mais elle ne semble pas adaptée à Excel :

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
Dim range As range
Dim i As Long
Dim TargetList
 
TargetList = Array("mot1", "mot2", "mot3") ' put list of terms to find here
 
For y = 0 To UBound(TargetList)
    Set range = ActiveDocument.range
    With range.Find
        .Text = TargetList(i)
        .Format = True
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        Do While .Execute(Forward:=True) = True
            range.Font.Strikethrough = True
        Loop
    End With
Next

En fait, j'en ai trouvé plusieurs et à chaque fois le même problème se pose : seule la première occurrence est mise en forme.

J'ai adapté la macro pour mon cas où il faut aller chercher dans un autre fichier :

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
    ' Create Word object
    Set wordApp = CreateObject("Word.Application")
    wordFullPath = "C:\MonFichierWord.doc"
 
    wordApp.Visible = True
 
    'Ouverture du template
    Set wordDoc = wordApp.Documents.Open(wordFullPath)
 
    'Déclaration de l'objet de sélection du texte
    Set objSelection = wordApp.Selection
 
'Dim range As range
Dim y As Long
Dim TargetList
 
TargetList = Array("mot1", "mot2", "mot3") ' put list of terms to find here
 
For y = 0 To UBound(TargetList)
    'Set range = wordDoc.Content.range
    With objSelection.Find
        .Text = TargetList(y)
        .Format = True
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        Do While .Execute(Forward:=True) = True
            objSelection.Font.Strikethrough = True
        Loop
    End With
Next

Voyez-vous ce qui ne va pas dans mon code ? (Je débute en VBA...)

Merci d'avance pour votre aide.

[clementmarcotte]

Bonjour,

Oublie la recherche-remplacement et regarde du côté des signets, des champs de base de données ou même du publipostage.

[Invité]

Bonjour,

Autre solution que celle de Clément que je salue.

Il faut revenir au début du document à chaque boucle :

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
 
   For y = 0 To UBound(TargetList)
       objSelection.HomeKey unit:=wdStory, Extend:=wdMove
       With objSelection.Find
            .Text = TargetList(y)
            .Format = True
            .MatchCase = True
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            Do While .Execute(Forward:=True) = True
                objSelection.Font.Strikethrough = True
            Loop
       End With
   Next y