Sub Excel_Word()
Dim oWdApp As Object 'Word.Application
Dim oWdDoc As Object 'Word.Document
'Lancer une instance Word
Set oWdApp = CreateObject("Word.Application")
'Ouvrir un nouveau contrat en fonction de la combinaison en I4
Set oWdDoc = oWdApp.Documents.Open("C:\CONTRAT\" & [I4] & ".doc")
'Rendre Word visible
oWdApp.Visible = True
'Enregistrer sous le nouveau contrat en prenant comme référence le nom du salarié en I5
oWdDoc.SaveAs ("C:\CONTRAT\" & [I5] & ".doc")
'Remplacer tous les xxx du document word créé par ce qui est marqué en E14
Dim Mot As String, Doc As String
Mot = Range("E14").Value
On Error GoTo Err1
Set oWdApp = GetObject(, "Word.Application")
For Each oWdDoc In oWdApp.Documents
oWdDoc.Activate
With oWdApp.Selection
.WholeStory
.Find.ClearFormatting
.Find.Replacement.ClearFormatting
With .Find
.Text = "xxx"
.Replacement.Text = Mot
.Forward = True
.Wrap = 2
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
oWdApp.DisplayAlerts = 0
.Find.Execute Replace:=2
oWdApp.DisplayAlerts = -1
End With
Next
On Error GoTo 0
Exit Sub
Err1:
MsgBox "Erreur"
End Sub