Rechercher/remplacer par dans word depuis Excel

[ANOVA]

Bonjour,

j'ai un problème que je simplifie comme suit afin de me faire comprendre :

j'ai un classeur Excel. J'ai un document word. Ce document word contient le texte "<BALISE>". Je veux faire une macro Excel qui va ouvrir le document word et remplacer le texte "<BALISE>" par un texte quelconque (en vrai la valeur d'une cellule). Je fais ceci :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub test()
    'On déclare, instancie et affiche Word :
    Dim traitementTexte As Word.Application
    Set traitementTexte = New Word.Application
    traitementTexte.Visible = True
 
    'On ouvre le bon document
    Dim leDoc As Document
    Set leDoc = traitementTexte.Documents.Open("C:\Bureau\Modele Word.docx")
 
    'On tente de remplacer <BALISE> par le texte de remplacement :
    leDoc.Content.Find.Execute FindText:="<BALISE>", ReplaceWith:="texte de remplacement", Replace:=WdReplaceAll
End Sub

En ayant au préalable activé la référence Microsort Word 12.0 Object Library. J'obtiens le message d'erreur en pièce jointe.

Ma question est : pourquoi ? Où est le problème dans mon code ?

Je vous remercie.

Cordialement.

[MattChess]

Envoyé par ANOVA

mon code fonctionne chez toi ?

Oui, il n'y a pas de problème apparent dans le code ci-dessus.
La substitution de chaque tag "<BALISE>" ne fait correctement dans le document Word.

On a ajouté un contrôle d'erreur à l'ouverture du document Word, une sauvegarde du document, la fermeture de Word et la libération de l'objet associé par la procédure WordReplace().

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
58
59
Option Explicit ' Remplace "<BALISE>" dans un document Word via Excel VBA
' VBE menu "Tools" > "References" [x] Microsoft Word NN.0 Object Library
 
Const filenameDoc = "C:\Bureau\Modele Word.docx"
 
Const tagToReplace = "<BALISE>" ' Mot clé à remplacer
 
' Point d'entrée principal : ouvre le document Word, remplace le tag, sauve, ferme Word.
Sub WordReplace()
Dim wordApp As Word.Application, wordDoc As Document, strReplace As String
 
    strReplace = "texte de remplacement"
    Stop ' Faire du pas à pas dans le débogueur
 
    'On déclare, instancie et affiche Word :
    Set wordApp = New Word.Application
    wordApp.Visible = True
    'On ouvre le bon document
    If WordOpen(filenameDoc, wordApp, wordDoc) Then
        'On tente de remplacer <BALISE> par le texte de remplacement :
        wordDoc.Content.Find.Execute FindText:=tagToReplace, _
                                     ReplaceWith:=strReplace, Replace:=wdReplaceAll
        WordSave wordDoc, filenameDoc
    End If
    wordApp.Quit
    Set wordApp = Nothing
End Sub
 
' Ouvre le document Word
Function WordOpen(ByVal strFilename As String, ByVal wordApp As Word.Application, _
            ByRef wordDoc As Word.Document) As Boolean
    WordOpen = False
    On Error Resume Next
    Set wordDoc = wordApp.Documents.Open(strFilename, ReadOnly:=False)
    If Err.Number <> 0 Then Warning "1000: Impossible d'ouvrir " + strFilename: Exit Function
    On Error GoTo 0
    WordOpen = True
End Function
 
' Sauve le document Word
Function WordSave(wordDoc As Word.Document, ByVal strFilename As String) As Boolean
    WordSave = False
    On Error Resume Next
    wordDoc.Application.ActiveDocument.Save
    If Err.Number <> 0 Then
        Warning "2000: Impossible de sauver " + strFilename: Exit Function
    End If
    On Error GoTo 0
    WordSave = True
End Function
 
'Common error management
Sub Warning(ByVal strMsg As String)
Const lenErr = 4 ' Number of digits of the error code beginning the message
    If Err.Number <> 0 Then
        strMsg = strMsg + vbCrLf + "Error " + Str(Err.Number) + ": " + Err.Description
    End If
    MsgBox Mid(strMsg, lenErr + 3), vbExclamation, "Excel to Word warning " + Left(strMsg, lenErr)
End Sub

Dans la fenêtre d'Exécution immédiate (Ctrl+G) du VBE (Visual Basic Editeur) d'Excel, copier-coller et valider par ENTER :

Code :

WordReplace

Les deux tags "<BALISE>" ont été remplacés dans le document Word.

Bug Automation

Envoyé par ANOVA

Erreur d'exécution '-2147023113 (800706f7)':

Erreur Automation
Le relais a reçu des données incorrectes.

Ce n'est pas un bug de code VBA mais d'installation de bibliothèques Office.

MS Support : client Automation reçoit un message d'erreur ou se bloque lorsque le client appelle l'objet Find dans Word.
Essayez sans utiliser le type Word.Application en Early Binding mais Object en Late Binding.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
' Point d'entrée principal : ouvre le document Word, remplace le tag, sauve, ferme Word.
Sub WordReplace()
'Dim wordApp As Word.Application, wordDoc As Document ' Early binding
Dim wordApp As Object, wordDoc As Object ' Late binding
Dim strReplace As String

    strReplace = "texte de remplacement"
    Stop ' Faire du pas à pas dans le débogueur
    
    'On déclare, instancie et affiche Word :
'    Set wordApp = New Word.Application
    Set wordApp = CreateObject("Word.Application") ' Late binding

___________

Si la discussion est résolue, vous pouvez cliquer sur le bouton

En bas de ce message s'il vous a apporté des éléments de réponse pertinents, pensez également à voter en cliquant sur le bouton vert ci-dessous.

[ANOVA]

Le message d'erreur est :

Erreur d'exécution '-2147023113 (800706f7)':

Erreur Automation
Le relais a reçu des données incorrectes.

Je te remercie pour ton code. Je vais regarder ça dès que possible. Juste un truc : mon code fonctionne chez toi ?