[XL-2013] Remplacement d'un texte d'une cellule Excel par un mot dans Word

Remplacement d'un texte d'une cellule Excel par un mot dans Word

Bonjour à tous,

J'essaye de remplacer dans un fichier Word, à chaque fois qu'il y a "XXX", par une cellule excel que j'ai nommé.

Malgré mes recherches, mon code devrait être bon mais il ne remplace qu'une fois "XXX" dans le fichier Word et les autres "XXX", il les laisse tel quel.

Code:

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
Sub Offre_type_test()
 
 
Dim AppWord As Object
Dim DocWord As Object
 
Dim Nom_Fic_A_Enregistrer As String, Nom_Fenetre As String
Dim ExtGamme As String
 
 
Set AppWord = CreateObject("Word.Application")
AppWord.Visible = True
Set DocWord = AppWord.Documents.Open("C:\Users\geo\Desktop\V2.4\Offre Type.docx")
 
AppWord.ActiveWindow.View.ReadingLayout = False
 
 
    ' *******************************************************************************************
    ' NOM DE LA SOCIETE
    ' *******************************************************************************************
    ' Sélection des données de la fiche signalétique
 
 
    Application.Goto Reference:="Nom_Client"
    Selection.Copy
 
 
    AppWord.Selection.HomeKey  'Unit:=(wdStory)
    AppWord.Selection.Find.ClearFormatting
    AppWord.Selection.Find.Replacement.ClearFormatting
 
 
 
 
    With AppWord.Selection.Find
        .Text = "XXX"
        .Replacement.Text = ActiveCell.Value
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
 
 
 
    End With
 
 
    AppWord.Selection.Find.Execute Replace:=wdReplaceAll
 
 
    AppWord.Selection.PasteSpecial Link:=False
 
End Sub

PS : je suis obligé de mettre Unit:=(wdStory) en commentaire, sinon j'ai un message d'erreur (paramètre incorrect)

Essaye ça :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Offre_type_test()
Dim DocWord As  Word.Document
 
Set DocWord = GetObject("C:\Users\geo\Desktop\V2.4\Offre Type.docx")
DocWord.Application.Visible = True
DocWord.Application.ActiveWindow.View.ReadingLayout = False
 
With DocWord.Content.Find
        .Text = "XXX"
        .Replacement.Text = Range("Nom_Client")
        .MatchCase = False
        .MatchWholeWord = False
        .Execute Replace:=wdReplaceAll
End With
 
End Sub

Merci pour ton aide mais la macro que tu m'as envoyé s’exécute mais ne change rien au fichier Word