'Programme principal Sub creationword For i = 1 to 3 creationword Next End sub 'Creation d'un nouveau word Public Sub creationword() ' Les données de la UserForm : Dim repert As String 'chemin acces Dim appWord As Word.Application Dim docWord As Word.Document '2 - ouvrir le document a modifier Suite: 'rep courant Dim CheminComplet As String Dim VarTabSplit Dim IntCnt As Integer Dim Chemin As String CheminComplet = ActiveWorkbook.Path VarTabSplit = Split(ActiveWorkbook.Path, "") Chemin = "" For IntCnt = 0 To UBound(VarTabSplit) - 1 Chemin = Chemin & VarTabSplit(IntCnt) & "" Next IntCnt repert = Chemin repert = repert & "template\Proposal.doc" Set appWrd = CreateObject("Word.Application") appWrd.Visible = True Set docWord = appWrd.Documents.Open(repert) ' 3 - Placer les données dans le document 'remplir produit On Error GoTo rien3 For i = 1 To 12 tampix = "Prd" & i RemplirSignet tampix, Prd Next rien3: 'ActiveDocument.Fields.Update ' màj des champs pour le renvoi sur Titre '4 sauvegarde word 'chemin et enregister sous CheminComplet = ActiveWorkbook.Path VarTabSplit = Split(ActiveWorkbook.Path, "") Chemin = "" For IntCnt = 0 To UBound(VarTabSplit) - 1 Chemin = Chemin & VarTabSplit(IntCnt) & "" Next IntCnt appWrd.Visible = True repert = Chemin repert = repert & "J\CD" & Prd & ".doc" 'appWrd.Visible = True 'On Error GoTo rienz appWrd.ActiveDocument.SaveAs Filename:=repert appWrd.ActiveDocument.Close appWrd.Quit savechanges:=False Set appWrd = Nothing DoEvents rienz: End Sub ' ******************************* ' *** Utilisation des signets *** ' ******************************* Public Sub RemplirSignet(S As String, T As String) ' Remplit le signet S avec le texte T sans détruire S On Error GoTo rien Dim Place As Long Place = ActiveDocument.Bookmarks(S).Range.Start ActiveDocument.Bookmarks(S).Range.Text = T ActiveDocument.Bookmarks.Add Name:=S, _ Range:=ActiveDocument.Range(Place, Place + Len(T)) rien: End Sub