Bonjour à tous,
Je suis désolé de vous resoliciter de nouveau, mais ma macro ne fonctionne pas malgré une absence d'erreur. Pour vous la décrire :
- La macro ouvre un document word déjà préexistant en fonction du nom marqué en cellule I4.
- La macro enregistre ce document en fonction du nom marqué en cellule I5.
- La macro remplace tous les "xxx" du document par ce qui est marqué en E14.
C'est cette dernière étape qui ne marche pas, malgré le fait qu'il n'y ait pas d'erreur.
Qu'ai-je manqué
Merci pour votre retour !
Je suis désolé de vous resoliciter de nouveau, mais ma macro ne fonctionne pas malgré une absence d'erreur. Pour vous la décrire :
- La macro ouvre un document word déjà préexistant en fonction du nom marqué en cellule I4.
- La macro enregistre ce document en fonction du nom marqué en cellule I5.
- La macro remplace tous les "xxx" du document par ce qui est marqué en E14.
C'est cette dernière étape qui ne marche pas, malgré le fait qu'il n'y ait pas d'erreur.
Qu'ai-je manqué
Merci pour votre retour !
Code:
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
